/-! # Erdos 859: counterexample submission Single-file proof body for conjectures.io's counterexample task fc-8432eac9-erdos859-erdos-859-0087a1d40d-counterexample-v1. The trusted submission wrapper supplies the imports and the Bounty namespace. All helper declarations and the third-party license are included below. -/ noncomputable section open scoped Classical /- BEGIN isolated base development. -/ section open Filter Asymptotics Finset open scoped Topology namespace Erdos859Verification /-- Every divisor used to represent `t` is at most `t`; hence membership for positive integers depends only on their residue class modulo `t!`. -/ theorem divisorSumSet_iff_of_modEq_factorial {t n m : ℕ} (hn : n ≠ 0) (hm : m ≠ 0) (hmod : Nat.ModEq t.factorial n m) : n ∈ Erdos859.DivisorSumSet t ↔ m ∈ Erdos859.DivisorSumSet t := by have transfer {a b : ℕ} (hb : b ≠ 0) (hab : Nat.ModEq t.factorial a b) (ha : a ∈ Erdos859.DivisorSumSet t) : b ∈ Erdos859.DivisorSumSet t := by obtain ⟨s, hs, hsum⟩ := ha refine ⟨s, ?_, hsum⟩ intro i hi have hid : i ∈ a.divisors := hs hi have hip : 0 < i := Nat.pos_of_mem_divisors hid have hit : i ≤ t := by rw [hsum] exact Finset.single_le_sum (fun j _ ↦ Nat.zero_le j) hi exact Nat.mem_divisors.mpr ⟨(hab.dvd_iff (Nat.dvd_factorial hip hit)).mp (Nat.mem_divisors.mp hid).1, hb⟩ exact ⟨transfer hm hmod, transfer hn hmod.symm⟩ /-- Sum a periodic real sequence over a whole number of periods. -/ theorem sum_range_periodic_mul {f : ℕ → ℝ} {m : ℕ} (hp : Function.Periodic f m) (q : ℕ) : ∑ i ∈ range (q * m), f i = (q : ℝ) * ∑ i ∈ range m, f i := by induction q with | zero => simp | succ q ih => rw [Nat.succ_mul, sum_range_add, ih] have heq : (∑ i ∈ range m, f (q * m + i)) = ∑ i ∈ range m, f i := by apply sum_congr rfl intro i _ simpa [add_comm] using hp.nat_mul q i rw [heq, Nat.cast_add, Nat.cast_one] ring /-- Quotient and remainder split the sum of a periodic sequence. -/ theorem sum_range_periodic_decompose {f : ℕ → ℝ} {m : ℕ} (hp : Function.Periodic f m) (n : ℕ) : ∑ i ∈ range n, f i = (n / m : ℕ) * (∑ i ∈ range m, f i) + ∑ i ∈ range (n % m), f i := by conv_lhs => rw [← Nat.div_add_mod n m, Nat.mul_comm m (n / m)] rw [sum_range_add, sum_range_periodic_mul hp] congr 1 apply sum_congr rfl intro i _ simpa [add_comm] using hp.nat_mul (n / m) i /-- The Cesàro mean of a bounded periodic sequence is its mean over one period. -/ theorem tendsto_mean_periodic {f : ℕ → ℝ} {m : ℕ} (hm : 0 < m) (hp : Function.Periodic f m) (h0 : ∀ i, 0 ≤ f i) (h1 : ∀ i, f i ≤ 1) : Tendsto (fun n : ℕ ↦ (∑ i ∈ range n, f i) / n) atTop (𝓝 ((∑ i ∈ range m, f i) / m)) := by let s := ∑ i ∈ range m, f i have hmR : (0 : ℝ) < m := by exact_mod_cast hm have hs0 : 0 ≤ s := sum_nonneg (fun i _ ↦ h0 i) have hs1 : s ≤ m := by calc s ≤ ∑ _i ∈ range m, (1 : ℝ) := sum_le_sum (fun i _ ↦ h1 i) _ = m := by simp have hsdiv0 : 0 ≤ s / m := div_nonneg hs0 hmR.le have hsdiv1 : s / m ≤ 1 := (div_le_one hmR).mpr hs1 have hbound : ∀ n : ℕ, |(∑ i ∈ range n, f i) - (n : ℝ) * (s / m)| ≤ m := by intro n have hr0 : 0 ≤ ∑ i ∈ range (n % m), f i := sum_nonneg (fun i _ ↦ h0 i) have hr1 : (∑ i ∈ range (n % m), f i) ≤ m := by calc _ ≤ ∑ _i ∈ range (n % m), (1 : ℝ) := sum_le_sum (fun i _ ↦ h1 i) _ = (n % m : ℕ) := by simp _ ≤ (m : ℝ) := by exact_mod_cast (Nat.mod_lt n hm).le have hrm0 : (0 : ℝ) ≤ (n % m : ℕ) * (s / m) := mul_nonneg (Nat.cast_nonneg _) hsdiv0 have hrm1 : (n % m : ℕ) * (s / m) ≤ (m : ℝ) := by calc _ ≤ (n % m : ℕ) * (1 : ℝ) := mul_le_mul_of_nonneg_left hsdiv1 (Nat.cast_nonneg _) _ ≤ (m : ℝ) := by simpa using (show ((n % m : ℕ) : ℝ) ≤ m by exact_mod_cast (Nat.mod_lt n hm).le) have hn : (n : ℝ) = m * (n / m : ℕ) + (n % m : ℕ) := by exact_mod_cast (Nat.div_add_mod n m).symm rw [sum_range_periodic_decompose hp, hn] change |(n / m : ℕ) * s + (∑ i ∈ range (n % m), f i) - (m * (n / m : ℕ) + (n % m : ℕ)) * (s / m)| ≤ m have heq : (n / m : ℕ) * s + (∑ i ∈ range (n % m), f i) - (m * (n / m : ℕ) + (n % m : ℕ)) * (s / m) = (∑ i ∈ range (n % m), f i) - (n % m : ℕ) * (s / m) := by field_simp ring rw [heq, abs_le] constructor <;> linarith have hzero : Tendsto (fun n : ℕ ↦ (∑ i ∈ range n, f i) / n - s / m) atTop (𝓝 0) := by apply squeeze_zero_norm' _ (tendsto_const_div_atTop_nhds_zero_nat (m : ℝ)) filter_upwards [eventually_gt_atTop 0] with n hn have hnR : (0 : ℝ) < n := by exact_mod_cast hn have heq : (∑ i ∈ range n, f i) / n - s / m = ((∑ i ∈ range n, f i) - (n : ℝ) * (s / m)) / n := by field_simp rw [Real.norm_eq_abs, heq, abs_div, abs_of_pos hnR] exact div_le_div_of_nonneg_right (hbound n) hnR.le exact tendsto_sub_nhds_zero_iff.mp hzero /-- Express the partial density as an average of a real-valued indicator. -/ theorem partialDensity_eq_indicator_mean (S : Set ℕ) (n : ℕ) : S.partialDensity Set.univ n = (∑ i ∈ range n, S.indicator (fun _ ↦ (1 : ℝ)) i) / n := by classical have hset : S ∩ Set.Iio n = (((range n).filter (· ∈ S) : Finset ℕ) : Set ℕ) := by ext i simp [and_comm] simp only [Set.partialDensity, Set.inter_univ, Set.univ_inter, hset, Set.ncard_coe_finset, Nat.ncard_Iio] congr 1 simp [Set.indicator] /-- An eventual equality of indicator functions preserves their natural density. -/ theorem hasDensity_of_indicator_mean {S : Set ℕ} {f : ℕ → ℝ} {a : ℝ} (hmean : Tendsto (fun n : ℕ ↦ (∑ i ∈ range n, f i) / n) atTop (𝓝 a)) (heq : ∀ᶠ n in atTop, S.indicator (fun _ ↦ (1 : ℝ)) n = f n) : S.HasDensity a := by have hdiff : Tendsto (fun n ↦ S.indicator (fun _ ↦ (1 : ℝ)) n - f n) atTop (𝓝 0) := by apply tendsto_const_nhds.congr' filter_upwards [heq] with n hn simp [hn] have hcesaro := hdiff.cesaro have hcombined := hcesaro.add hmean change Tendsto (fun n ↦ S.partialDensity Set.univ n) atTop (𝓝 a) convert hcombined using 1 · funext n rw [partialDensity_eq_indicator_mean] simp only [sum_sub_distrib, div_eq_mul_inv] ring · simp /-- A set agreeing eventually with a bounded periodic indicator has a density. -/ theorem hasDensity_of_periodic_indicator {S : Set ℕ} {f : ℕ → ℝ} {m : ℕ} (hm : 0 < m) (hp : Function.Periodic f m) (h0 : ∀ i, 0 ≤ f i) (h1 : ∀ i, f i ≤ 1) (heq : ∀ᶠ n in atTop, S.indicator (fun _ ↦ (1 : ℝ)) n = f n) : S.HasDensity ((∑ i ∈ range m, f i) / m) := hasDensity_of_indicator_mean (tendsto_mean_periodic hm hp h0 h1) heq /-- A periodic indicator for the divisor-sum event, using positive representatives. -/ noncomputable def divisorIndicator (t n : ℕ) : ℝ := (Erdos859.DivisorSumSet t).indicator (fun _ ↦ (1 : ℝ)) (n % t.factorial + t.factorial) theorem divisorIndicator_nonneg (t n : ℕ) : 0 ≤ divisorIndicator t n := by classical unfold divisorIndicator by_cases h : n % t.factorial + t.factorial ∈ Erdos859.DivisorSumSet t · simp [h] · simp [h] theorem divisorIndicator_le_one (t n : ℕ) : divisorIndicator t n ≤ 1 := by classical unfold divisorIndicator by_cases h : n % t.factorial + t.factorial ∈ Erdos859.DivisorSumSet t · simp [h] · simp [h] theorem divisorIndicator_periodic (t : ℕ) : Function.Periodic (divisorIndicator t) t.factorial := by intro n simp [divisorIndicator] theorem divisorIndicator_eventually_eq (t : ℕ) : ∀ᶠ n in atTop, (Erdos859.DivisorSumSet t).indicator (fun _ ↦ (1 : ℝ)) n = divisorIndicator t n := by classical filter_upwards [eventually_gt_atTop 0] with n hn have hrep : n % t.factorial + t.factorial ≠ 0 := ne_of_gt (lt_of_lt_of_le (Nat.factorial_pos t) (Nat.le_add_left _ _)) have hmod : Nat.ModEq t.factorial n (n % t.factorial + t.factorial) := by simp [Nat.ModEq] have hiff := divisorSumSet_iff_of_modEq_factorial hn.ne' hrep hmod simp only [divisorIndicator, Set.indicator_apply, hiff] /-- The exact density, as a finite average over residue classes modulo `t!`. -/ noncomputable def divisorDensity (t : ℕ) : ℝ := (∑ i ∈ range t.factorial, divisorIndicator t i) / t.factorial /-- Unconditional existence of the natural density of each divisor-sum set. -/ theorem divisorSumSet_hasDensity (t : ℕ) : (Erdos859.DivisorSumSet t).HasDensity (divisorDensity t) := hasDensity_of_periodic_indicator (Nat.factorial_pos t) (divisorIndicator_periodic t) (divisorIndicator_nonneg t) (divisorIndicator_le_one t) (divisorIndicator_eventually_eq t) theorem factorial_mem_divisorSumSet (t : ℕ) : t.factorial ∈ Erdos859.DivisorSumSet t := by by_cases ht : t = 0 · subst t exact ⟨∅, by simp, by simp⟩ · refine ⟨{t}, ?_, by simp⟩ intro i hi have hi' : i = t := by simpa using hi subst i exact Nat.mem_divisors.mpr ⟨Nat.dvd_factorial (Nat.pos_of_ne_zero ht) le_rfl, Nat.factorial_ne_zero t⟩ theorem divisorIndicator_zero (t : ℕ) : divisorIndicator t 0 = 1 := by simp [divisorIndicator, factorial_mem_divisorSumSet] /-- Each exact density is strictly positive. -/ theorem divisorDensity_pos (t : ℕ) : 0 < divisorDensity t := by have hs : 1 ≤ ∑ i ∈ range t.factorial, divisorIndicator t i := by rw [← divisorIndicator_zero t] exact single_le_sum (fun i _ ↦ divisorIndicator_nonneg t i) (mem_range.mpr (Nat.factorial_pos t)) exact div_pos (lt_of_lt_of_le zero_lt_one hs) (by exact_mod_cast Nat.factorial_pos t) theorem divisorDensity_le_one (t : ℕ) : divisorDensity t ≤ 1 := by exact (divisorSumSet_hasDensity t).mono (Set.subset_univ _) Set.HasDensity.univ /-- The positive-density variant, proved without using its imported placeholder. -/ theorem divisorSumSet_hasPosDensity (t : ℕ) : (Erdos859.DivisorSumSet t).HasPosDensity := ⟨divisorDensity t, divisorDensity_pos t, divisorSumSet_hasDensity t⟩ /-- A uniformly sampled residue is divisible by `d` with frequency `1/d`. -/ theorem tendsto_mean_dvd_indicator {d : ℕ} (hd : 0 < d) : Tendsto (fun N : ℕ ↦ (∑ n ∈ range N, if d ∣ n then (1 : ℝ) else 0) / N) atTop (𝓝 (1 / (d : ℝ))) := by have hp : Function.Periodic (fun n ↦ if d ∣ n then (1 : ℝ) else 0) d := by intro n simp only [← Nat.dvd_add_iff_left (dvd_refl d)] have h0 : ∀ n : ℕ, (0 : ℝ) ≤ if d ∣ n then 1 else 0 := by intro n split_ifs <;> norm_num have h1 : ∀ n : ℕ, (if d ∣ n then (1 : ℝ) else 0) ≤ 1 := by intro n split_ifs <;> norm_num have hs : (∑ n ∈ range d, if d ∣ n then (1 : ℝ) else 0) = 1 := by rw [sum_eq_single 0] · simp · intro n hn hn0 have hnd : ¬ d ∣ n := by intro hdn have hle := Nat.le_of_dvd (Nat.pos_of_ne_zero hn0) hdn exact (not_le.mpr (mem_range.mp hn)) hle simp [hnd] · intro hnot exact False.elim (hnot (mem_range.mpr hd)) simpa only [hs] using tendsto_mean_periodic hd hp h0 h1 /-- Sum the small positive divisors, with the zero sample harmlessly included. -/ noncomputable def smallDivisorSum (y n : ℕ) : ℝ := ∑ d ∈ Icc 1 y, if d ∣ n then (d : ℝ) else 0 theorem smallDivisorSum_nonneg (y n : ℕ) : 0 ≤ smallDivisorSum y n := by apply sum_nonneg intro d _ split_ifs <;> positivity /-- Each small divisor contributes exactly one to the limiting mean. -/ theorem tendsto_mean_smallDivisorSum (y : ℕ) : Tendsto (fun N : ℕ ↦ (∑ n ∈ range N, smallDivisorSum y n) / N) atTop (𝓝 (y : ℝ)) := by have heach : ∀ d ∈ Icc 1 y, Tendsto (fun N : ℕ ↦ (∑ n ∈ range N, if d ∣ n then (d : ℝ) else 0) / N) atTop (𝓝 (1 : ℝ)) := by intro d hd have hd0 : 0 < d := (mem_Icc.mp hd).1 have hdR : (d : ℝ) ≠ 0 := by exact_mod_cast hd0.ne' have h := (tendsto_mean_dvd_indicator hd0).const_mul (d : ℝ) convert h using 1 · funext N rw [← mul_div_assoc, mul_sum] congr 1 apply sum_congr rfl intro n _ split_ifs <;> simp · field_simp have hsum := tendsto_finsetSum (Icc 1 y) heach convert hsum using 1 · funext N simp only [smallDivisorSum, sum_div] rw [sum_comm] · simp /-- Integers with a divisor in the half-open interval `(y,t]`. -/ def DivisorIntervalSet (y t : ℕ) : Set ℕ := {n | ∃ d : ℕ, y < d ∧ d ≤ t ∧ d ∣ n} theorem divisorInterval_periodic (y t : ℕ) : Function.Periodic ((DivisorIntervalSet y t).indicator (fun _ ↦ (1 : ℝ))) t.factorial := by classical intro n have heq : n + t.factorial ∈ DivisorIntervalSet y t ↔ n ∈ DivisorIntervalSet y t := by constructor · rintro ⟨d, hyd, hdt, hd⟩ exact ⟨d, hyd, hdt, (Nat.dvd_add_iff_left (Nat.dvd_factorial (lt_of_le_of_lt (Nat.zero_le y) hyd) hdt)).mpr hd⟩ · rintro ⟨d, hyd, hdt, hd⟩ exact ⟨d, hyd, hdt, (Nat.dvd_add_iff_left (Nat.dvd_factorial (lt_of_le_of_lt (Nat.zero_le y) hyd) hdt)).mp hd⟩ simp only [Set.indicator_apply, heq] /-- The divisor-interval density as an exact residue-class average. -/ noncomputable def divisorIntervalDensity (y t : ℕ) : ℝ := (∑ n ∈ range t.factorial, (DivisorIntervalSet y t).indicator (fun _ ↦ (1 : ℝ)) n) / t.factorial theorem divisorInterval_hasDensity (y t : ℕ) : (DivisorIntervalSet y t).HasDensity (divisorIntervalDensity y t) := by classical apply hasDensity_of_periodic_indicator (Nat.factorial_pos t) (divisorInterval_periodic y t) · intro n by_cases hn : n ∈ DivisorIntervalSet y t <;> simp [hn] · intro n by_cases hn : n ∈ DivisorIntervalSet y t <;> simp [hn] · exact Filter.Eventually.of_forall (fun _ ↦ rfl) /-- A representation avoiding large divisors must use at least `t` in small divisors. -/ theorem le_smallDivisorSum_of_no_large_divisor {t y n : ℕ} (hrep : n ∈ Erdos859.DivisorSumSet t) (hno : n ∉ DivisorIntervalSet y t) : (t : ℝ) ≤ smallDivisorSum y n := by classical obtain ⟨s, hs, hsum⟩ := hrep have hsub : s ⊆ Icc 1 y := by intro d hd have hdiv : d ∈ n.divisors := hs hd have hdt : d ≤ t := by rw [hsum] exact single_le_sum (fun i _ ↦ Nat.zero_le i) hd have hdy : d ≤ y := by by_contra h exact hno ⟨d, lt_of_not_ge h, hdt, (Nat.mem_divisors.mp hdiv).1⟩ exact mem_Icc.mpr ⟨Nat.pos_of_mem_divisors hdiv, hdy⟩ calc (t : ℝ) = ∑ d ∈ s, (d : ℝ) := by rw [hsum, Nat.cast_sum] _ = ∑ d ∈ s, if d ∣ n then (d : ℝ) else 0 := by apply sum_congr rfl intro d hd simp [(Nat.mem_divisors.mp (hs hd)).1] _ ≤ smallDivisorSum y n := by apply sum_le_sum_of_subset_of_nonneg hsub intro i _ _ split_ifs <;> positivity /-- The deterministic inequality behind the divisor-interval upper bound. -/ theorem divisor_sum_indicator_le (t y n : ℕ) : (t : ℝ) * (Erdos859.DivisorSumSet t).indicator (fun _ ↦ (1 : ℝ)) n ≤ (t : ℝ) * (DivisorIntervalSet y t).indicator (fun _ ↦ (1 : ℝ)) n + smallDivisorSum y n := by classical by_cases hrep : n ∈ Erdos859.DivisorSumSet t · by_cases hlarge : n ∈ DivisorIntervalSet y t · simp only [Set.indicator_of_mem hrep, Set.indicator_of_mem hlarge, mul_one] linarith [smallDivisorSum_nonneg y n] · simpa only [Set.indicator_of_mem hrep, Set.indicator_of_notMem hlarge, mul_one, mul_zero, zero_add] using le_smallDivisorSum_of_no_large_divisor hrep hlarge · simp only [Set.indicator_of_notMem hrep, mul_zero] have hi : 0 ≤ (DivisorIntervalSet y t).indicator (fun _ ↦ (1 : ℝ)) n := by by_cases hn : n ∈ DivisorIntervalSet y t <;> simp [hn] exact add_nonneg (mul_nonneg (Nat.cast_nonneg t) hi) (smallDivisorSum_nonneg y n) /-- The exact density bound used before invoking a divisor-interval theorem. -/ theorem divisorDensity_le_intervalDensity_add (t y : ℕ) (ht : 0 < t) : divisorDensity t ≤ divisorIntervalDensity y t + (y : ℝ) / t := by have hleft : Tendsto (fun N : ℕ ↦ (t : ℝ) * ((Erdos859.DivisorSumSet t).partialDensity Set.univ N)) atTop (𝓝 ((t : ℝ) * divisorDensity t)) := (divisorSumSet_hasDensity t).const_mul (t : ℝ) have hright : Tendsto (fun N : ℕ ↦ (t : ℝ) * ((DivisorIntervalSet y t).partialDensity Set.univ N) + (∑ n ∈ range N, smallDivisorSum y n) / N) atTop (𝓝 ((t : ℝ) * divisorIntervalDensity y t + y)) := ((divisorInterval_hasDensity y t).const_mul (t : ℝ)).add (tendsto_mean_smallDivisorSum y) have hle : (t : ℝ) * divisorDensity t ≤ (t : ℝ) * divisorIntervalDensity y t + y := by apply le_of_tendsto_of_tendsto' hleft hright intro N rw [partialDensity_eq_indicator_mean, partialDensity_eq_indicator_mean, ← mul_div_assoc, ← mul_div_assoc, ← add_div] apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg N) rw [mul_sum, mul_sum, ← sum_add_distrib] exact sum_le_sum (fun n _ ↦ divisor_sum_indicator_le t y n) have htR : (0 : ℝ) < t := by exact_mod_cast ht have hdiv := (div_le_div_iff_of_pos_right htR).mpr hle simpa [add_div, htR.ne'] using hdiv /-- The coprime factors of a divisor product are uniquely determined. -/ theorem divisor_product_injective {b n d₁ d₂ e₁ e₂ : ℕ} (hbn : Nat.Coprime b n) (hd₁ : d₁ ∈ n.divisors) (hd₂ : d₂ ∈ n.divisors) (he₁ : e₁ ∈ b.divisors) (he₂ : e₂ ∈ b.divisors) (heq : d₁ * e₁ = d₂ * e₂) : d₁ = d₂ ∧ e₁ = e₂ := by have hc₁ : Nat.Coprime d₁ e₂ := (hbn.symm.of_dvd_left (Nat.mem_divisors.mp hd₁).1).of_dvd_right (Nat.mem_divisors.mp he₂).1 have hc₂ : Nat.Coprime d₂ e₁ := (hbn.symm.of_dvd_left (Nat.mem_divisors.mp hd₂).1).of_dvd_right (Nat.mem_divisors.mp he₁).1 have h₁ : d₁ ∣ d₂ := hc₁.dvd_of_dvd_mul_right (heq ▸ dvd_mul_right d₁ e₁) have h₂ : d₂ ∣ d₁ := hc₂.dvd_of_dvd_mul_right (heq.symm ▸ dvd_mul_right d₂ e₂) have hd : d₁ = d₂ := Nat.dvd_antisymm h₁ h₂ refine ⟨hd, ?_⟩ rw [hd] at heq exact Nat.eq_of_mul_eq_mul_left (Nat.pos_of_mem_divisors hd₂) heq /-- A practical coprime factor replaces each bounded coefficient by a disjoint sum of actual divisors. This verifies the lifting step of the manuscript. -/ theorem bounded_coefficients_mem_divisorSumSet {b n : ℕ} (hb : Nat.IsPractical b) (hb0 : b ≠ 0) (hn0 : n ≠ 0) (hbn : Nat.Coprime b n) (c : ℕ → ℕ) (hc : ∀ d ∈ n.divisors, c d ≤ b) : b * n ∈ Erdos859.DivisorSumSet (∑ d ∈ n.divisors, d * c d) := by classical have hchoice : ∀ d : ℕ, ∃ s : Finset ℕ, s ⊆ b.divisors ∧ (d ∈ n.divisors → c d = ∑ e ∈ s, e) := by intro d by_cases hd : d ∈ n.divisors · obtain ⟨s, hs, heq⟩ := hb (c d) (hc d hd) exact ⟨s, hs, fun _ ↦ heq⟩ · exact ⟨∅, by simp, fun h ↦ False.elim (hd h)⟩ choose s hs hsum using hchoice let pairs : Finset (Σ _d : ℕ, ℕ) := n.divisors.sigma s let values : Finset ℕ := pairs.image (fun p ↦ p.1 * p.2) have hinj : ∀ p ∈ pairs, ∀ q ∈ pairs, p.1 * p.2 = q.1 * q.2 → p = q := by intro p hp q hq heq obtain ⟨hdp, hep⟩ := mem_sigma.mp hp obtain ⟨hdq, heq'⟩ := mem_sigma.mp hq obtain ⟨hfirst, hsecond⟩ := divisor_product_injective hbn hdp hdq (hs p.1 hep) (hs q.1 heq') heq exact Sigma.ext hfirst (heq_of_eq hsecond) refine ⟨values, ?_, ?_⟩ · intro z hz obtain ⟨p, hp, rfl⟩ := mem_image.mp hz obtain ⟨hdp, hep⟩ := mem_sigma.mp hp apply Nat.mem_divisors.mpr constructor · rw [mul_comm b n] exact Nat.mul_dvd_mul (Nat.mem_divisors.mp hdp).1 (Nat.mem_divisors.mp (hs p.1 hep)).1 · exact Nat.mul_ne_zero hb0 hn0 · change (∑ d ∈ n.divisors, d * c d) = ∑ z ∈ pairs.image (fun p ↦ p.1 * p.2), z rw [sum_image hinj] change (∑ d ∈ n.divisors, d * c d) = ∑ p ∈ n.divisors.sigma s, p.1 * p.2 rw [sum_sigma] apply sum_congr rfl intro d hd rw [hsum d hd, mul_sum] /-- Adjoining a new prime at most `b + 1` preserves practicality. -/ theorem practical_mul_prime {b p : ℕ} (hb : Nat.IsPractical b) (hp : Nat.Prime p) (hcop : Nat.Coprime b p) (hpb : p ≤ b + 1) : Nat.IsPractical (b * p) := by intro m hm have hb0 : b ≠ 0 := by have := hp.two_le omega have hq : m / p ≤ b := by calc m / p ≤ (b * p) / p := Nat.div_le_div_right hm _ = b := Nat.mul_div_cancel b hp.pos have hr : m % p ≤ b := by have := Nat.mod_lt m hp.pos omega let c : ℕ → ℕ := fun d ↦ if d = 1 then m % p else if d = p then m / p else 0 have hc : ∀ d ∈ p.divisors, c d ≤ b := by intro d _ dsimp [c] split_ifs <;> omega have hsum : (∑ d ∈ p.divisors, d * c d) = m := by rw [hp.sum_divisors] simpa [c, hp.ne_one, add_comm] using Nat.mod_add_div m p have hrep := bounded_coefficients_mem_divisorSumSet hb hb0 hp.ne_zero hcop c hc rw [hsum] at hrep exact hrep theorem practical_one : Nat.IsPractical 1 := by intro m hm interval_cases m · exact ⟨∅, by simp, by simp⟩ · exact ⟨{1}, by simp, by simp⟩ /-- A fixed practical seed with all prime factors below the later prime windows. -/ theorem practical_210 : Nat.IsPractical 210 := by have h2 : Nat.IsPractical 2 := by simpa using practical_mul_prime practical_one (show Nat.Prime 2 by norm_num) (by decide) (by norm_num) have h6 : Nat.IsPractical 6 := by simpa using practical_mul_prime h2 (show Nat.Prime 3 by norm_num) (by decide) (by norm_num) have h30 : Nat.IsPractical 30 := by simpa using practical_mul_prime h6 (show Nat.Prime 5 by norm_num) (by decide) (by norm_num) simpa using practical_mul_prime h30 (show Nat.Prime 7 by norm_num) (by decide) (by norm_num) /-- Distance at most `eps` from some integer, stated using an explicit witness. -/ def NearInteger (eps x : ℝ) : Prop := ∃ z : ℤ, |x - z| ≤ eps theorem NearInteger.neg {eps x : ℝ} (h : NearInteger eps x) : NearInteger eps (-x) := by obtain ⟨z, hz⟩ := h refine ⟨-z, ?_⟩ simpa only [Int.cast_neg, neg_sub_neg, abs_sub_comm] using hz theorem NearInteger.abs {eps x : ℝ} (h : NearInteger eps x) : NearInteger eps |x| := by by_cases hx : 0 ≤ x · simpa only [abs_of_nonneg hx] using h · simpa only [abs_of_neg (lt_of_not_ge hx)] using h.neg /-- On the first half of a unit interval, a sufficiently small phase is near zero. -/ theorem small_of_nearInteger_of_le_half {eps x : ℝ} (heps : eps < 1 / 2) (hx0 : 0 ≤ x) (hx1 : x ≤ 1 / 2) (h : NearInteger eps x) : x ≤ eps := by obtain ⟨z, hz⟩ := h have hb := abs_le.mp hz have hzlo : (-1 : ℝ) < z := by linarith have hzhi : (z : ℝ) < 1 := by linarith have hzlo' : (-1 : ℤ) < z := by exact_mod_cast hzlo have hzhi' : z < 1 := by exact_mod_cast hzhi have hz0 : z = 0 := by omega subst z simpa only [Int.cast_zero, sub_zero, abs_of_nonneg hx0] using hz /-- A weight ratio at most `Y/2` cannot let a small phase jump to another integer. -/ theorem phase_no_wrap_step {Y x u v : ℝ} (hY : 2 < Y) (hx : 0 ≤ x) (hv : 0 ≤ v) (hprev : x * u ≤ 1 / Y) (hgap : v ≤ Y / 2 * u) (hphase : NearInteger (1 / Y) (x * v)) : x * v ≤ 1 / Y := by have hY0 : 0 < Y := by linarith have heps : (1 : ℝ) / Y < 1 / 2 := (div_lt_iff₀ hY0).mpr (by linarith) have hhalf : x * v ≤ 1 / 2 := by calc x * v ≤ x * (Y / 2 * u) := mul_le_mul_of_nonneg_left hgap hx _ = Y / 2 * (x * u) := by ring _ ≤ Y / 2 * (1 / Y) := mul_le_mul_of_nonneg_left hprev (by positivity) _ = 1 / 2 := by field_simp exact small_of_nearInteger_of_le_half heps (mul_nonneg hx hv) hhalf hphase /-- Propagate the initial zero phase through an entire finite chain. -/ theorem phase_no_wrap_chain {Y x : ℝ} {w : ℕ → ℝ} {k : ℕ} (hY : 2 < Y) (hx : 0 ≤ x) (hw : ∀ i ≤ k, 0 ≤ w i) (hstart : x * w 0 ≤ 1 / 2) (hgap : ∀ i < k, w (i + 1) ≤ Y / 2 * w i) (hphase : ∀ i ≤ k, NearInteger (1 / Y) (x * w i)) : x * w k ≤ 1 / Y := by have heps : (1 : ℝ) / Y < 1 / 2 := (div_lt_iff₀ (show 0 < Y by linarith)).mpr (by linarith) have hall : ∀ i ≤ k, x * w i ≤ 1 / Y := by intro i induction i with | zero => intro hi exact small_of_nearInteger_of_le_half heps (mul_nonneg hx (hw 0 hi)) hstart (hphase 0 hi) | succ i ih => intro hi exact phase_no_wrap_step hY hx (hw (i + 1) hi) (ih (by omega)) (hgap i (by omega)) (hphase (i + 1) hi) exact hall k le_rfl /-- A divisor chain reaching `r` rules out every nonzero rational phase `a/r` once the initial phase has been localized to the first half interval. -/ theorem no_nonzero_rational_phase_on_chain {Y : ℝ} {a : ℤ} {r k : ℕ} {w : ℕ → ℝ} (hY : 2 < Y) (ha : a ≠ 0) (hr : 0 < r) (hw : ∀ i ≤ k, 0 ≤ w i) (hlast : w k = r) (hstart : |(a : ℝ) / r| * w 0 ≤ 1 / 2) (hgap : ∀ i < k, w (i + 1) ≤ Y / 2 * w i) (hphase : ∀ i ≤ k, NearInteger (1 / Y) (((a : ℝ) / r) * w i)) : False := by have habsphase : ∀ i ≤ k, NearInteger (1 / Y) (|(a : ℝ) / r| * w i) := by intro i hi simpa only [abs_mul, abs_of_nonneg (hw i hi)] using (hphase i hi).abs have hbound := phase_no_wrap_chain hY (abs_nonneg ((a : ℝ) / r)) hw hstart hgap habsphase have hrR : (0 : ℝ) < r := by exact_mod_cast hr rw [hlast, abs_div, abs_of_pos hrR, div_mul_cancel₀ _ hrR.ne'] at hbound have haI : (1 : ℤ) ≤ |a| := by have habs : (0 : ℤ) < |a| := abs_pos.mpr ha omega have haR : (1 : ℝ) ≤ |(a : ℝ)| := by exact_mod_cast haI have heps : (1 : ℝ) / Y < 1 := (div_lt_one (show 0 < Y by linarith)).mpr (by linarith) linarith /-- Hölder transfer for a genuine observable taking values in `[0,1]`. -/ theorem holder_tilt_bound {ι : Type*} (s : Finset ι) {q : ℝ} (hq : 1 ≤ q) (w F L : ι → ℝ) (hw : ∀ i, 0 ≤ w i) (hF0 : ∀ i, 0 ≤ F i) (hF1 : ∀ i, F i ≤ 1) (hL : ∀ i, 0 ≤ L i) : (∑ i ∈ s, w i * F i * L i) ≤ (∑ i ∈ s, w i * F i) ^ (1 - q⁻¹) * (∑ i ∈ s, w i * L i ^ q) ^ q⁻¹ := by have h := Real.inner_le_weight_mul_Lp_of_nonneg s hq (fun i ↦ w i * F i) L (fun i ↦ mul_nonneg (hw i) (hF0 i)) hL refine h.trans (mul_le_mul_of_nonneg_left ?_ (Real.rpow_nonneg (sum_nonneg (fun i _ ↦ mul_nonneg (hw i) (hF0 i))) _)) apply Real.rpow_le_rpow · exact sum_nonneg (fun i _ ↦ mul_nonneg (mul_nonneg (hw i) (hF0 i)) (Real.rpow_nonneg (hL i) q)) · apply sum_le_sum intro i _ have hprod := mul_le_mul_of_nonneg_left (hF1 i) (hw i) have hpow := mul_le_mul_of_nonneg_right hprod (Real.rpow_nonneg (hL i) q) simpa only [mul_one] using hpow · exact inv_nonneg.mpr (le_trans zero_le_one hq) /-- The logarithmic rearrangement used to read off the transferred exponent. -/ theorem log_lower_bound_of_holder {q E S M : ℝ} (hq : 1 < q) (hE : 0 < E) (hS : 0 < S) (hM : 0 < M) (hholder : S ≤ E ^ (1 - q⁻¹) * M ^ q⁻¹) : (q * Real.log S - Real.log M) / (q - 1) ≤ Real.log E := by have hq0 : 0 < q := lt_trans zero_lt_one hq have hlog := Real.log_le_log hS hholder rw [Real.log_mul (Real.rpow_pos_of_pos hE _).ne' (Real.rpow_pos_of_pos hM _).ne', Real.log_rpow hE, Real.log_rpow hM] at hlog have hmul : q * Real.log S ≤ (q - 1) * Real.log E + Real.log M := by calc q * Real.log S ≤ q * ((1 - q⁻¹) * Real.log E + q⁻¹ * Real.log M) := mul_le_mul_of_nonneg_left hlog hq0.le _ = (q - 1) * Real.log E + Real.log M := by field_simp apply (div_le_iff₀ (sub_pos.mpr hq)).mpr nlinarith /-- Asymptotic equivalence to a power determines the logarithmic decay rate. -/ theorem tendsto_log_rate_of_equivalent {d b : ℕ → ℝ} {c p : ℝ} (hb : Tendsto b atTop atTop) (hc : 0 < c) (he : d ~[atTop] (fun n ↦ c / b n ^ p)) : Tendsto (fun n ↦ -Real.log (d n) / Real.log (b n)) atTop (𝓝 p) := by obtain ⟨φ, hφ, heq⟩ := he.exists_eq_mul have hlog : Tendsto (fun n ↦ Real.log (b n)) atTop atTop := Real.tendsto_log_atTop.comp hb have hφpos : ∀ᶠ n in atTop, 0 < φ n := hφ.eventually_const_lt zero_lt_one have hbpos : ∀ᶠ n in atTop, 1 < b n := hb.eventually_gt_atTop 1 have hnum : Tendsto (fun n ↦ Real.log (φ n) + Real.log c) atTop (𝓝 (Real.log c)) := by simpa using (hφ.log one_ne_zero).add_const (Real.log c) have haux : Tendsto (fun n ↦ p - (Real.log (φ n) + Real.log c) / Real.log (b n)) atTop (𝓝 p) := by simpa using tendsto_const_nhds.sub (hnum.div_atTop hlog) apply haux.congr' filter_upwards [heq, hφpos, hbpos] with n hn hφn hbn have hb0 : 0 < b n := lt_trans zero_lt_one hbn have hpow : 0 < b n ^ p := Real.rpow_pos_of_pos hb0 p change d n = φ n * (c / b n ^ p) at hn rw [hn, Real.log_mul hφn.ne' (div_pos hc hpow).ne', Real.log_div hc.ne' hpow.ne', Real.log_rpow hb0] field_simp [(Real.log_pos hbn).ne'] ring /-- Multiplying an equivalent power law by the matching power recovers its constant. -/ theorem tendsto_scaled_of_equivalent {d b : ℕ → ℝ} {c p : ℝ} (hb : Tendsto b atTop atTop) (he : d ~[atTop] (fun n ↦ c / b n ^ p)) : Tendsto (fun n ↦ b n ^ p * d n) atTop (𝓝 c) := by obtain ⟨φ, hφ, heq⟩ := he.exists_eq_mul have haux : Tendsto (fun n ↦ φ n * c) atTop (𝓝 c) := by simpa using hφ.mul_const c apply haux.congr' filter_upwards [heq, hb.eventually_gt_atTop 0] with n hn hbn change d n = φ n * (c / b n ^ p) at hn rw [hn] field_simp [(Real.rpow_pos_of_pos hbn p).ne'] /-- A sharp logarithmic exponent together with a vanishing leading coefficient excludes every positive constant power law. -/ theorem not_equivalent_of_liminf_and_scaled_limit {d b : ℕ → ℝ} {δ : ℝ} (hb : Tendsto b atTop atTop) (hliminf : atTop.liminf (fun n ↦ -Real.log (d n) / Real.log (b n)) = δ) (hscaled : Tendsto (fun n ↦ b n ^ δ * d n) atTop (𝓝 0)) : ¬ ∃ c > 0, ∃ p : ℝ, d ~[atTop] (fun n ↦ c / b n ^ p) := by rintro ⟨c, hc, p, he⟩ have hp : p = δ := (tendsto_log_rate_of_equivalent hb hc he).liminf_eq.symm.trans hliminf subst p have hc0 : c = 0 := tendsto_nhds_unique (tendsto_scaled_of_equivalent hb he) hscaled exact hc.ne' hc0 /-- The constant claimed by the manuscript. -/ noncomputable def delta : ℝ := 1 - (1 + Real.log (Real.log 2)) / Real.log 2 theorem log_two_pos : 0 < Real.log 2 := Real.log_pos (by norm_num) theorem log_two_lt_one : Real.log 2 < 1 := by have h := Real.log_lt_sub_one_of_pos (show (0 : ℝ) < 2 by norm_num) (by norm_num) linarith theorem half_lt_log_two : (1 : ℝ) / 2 < Real.log 2 := by have h := Real.log_lt_sub_one_of_pos (show (0 : ℝ) < (2 : ℝ)⁻¹ by norm_num) (show (2 : ℝ)⁻¹ ≠ 1 by norm_num) rw [Real.log_inv] at h norm_num at h linarith theorem delta_pos : 0 < delta := by have h := Real.log_lt_sub_one_of_pos log_two_pos log_two_lt_one.ne have hfrac : (1 + Real.log (Real.log 2)) / Real.log 2 < 1 := (div_lt_one log_two_pos).mpr (by linarith) exact sub_pos.mpr hfrac theorem delta_lt_one : delta < 1 := by have hlog : -Real.log 2 ≤ Real.log (Real.log 2) := by calc -Real.log 2 = Real.log ((2 : ℝ)⁻¹) := (Real.log_inv 2).symm _ ≤ Real.log (Real.log 2) := Real.log_le_log (by norm_num) (by simpa using half_lt_log_two.le) have hnum : 0 < 1 + Real.log (Real.log 2) := by linarith [log_two_lt_one] have hfrac := div_pos hnum log_two_pos dsimp [delta] linarith /-- The threshold appearing in the logarithmic subset-sum argument. -/ noncomputable def criticalTilt : ℝ := 1 / Real.log 2 theorem criticalTilt_pos : 0 < criticalTilt := div_pos zero_lt_one log_two_pos theorem one_lt_criticalTilt : 1 < criticalTilt := (one_lt_div log_two_pos).mpr log_two_lt_one theorem criticalTilt_lt_two : criticalTilt < 2 := (div_lt_iff₀ log_two_pos).mpr (by linarith [half_lt_log_two]) /-- The block-count deviation cost in the manuscript. -/ noncomputable def ballotCost (lam : ℝ) : ℝ := lam * Real.log 2 - 1 - Real.log (lam * Real.log 2) theorem ballotCost_critical : ballotCost criticalTilt = 0 := by simp [ballotCost, criticalTilt, log_two_pos.ne'] theorem entropy_critical : criticalTilt * Real.log criticalTilt - criticalTilt + 1 = delta := by dsimp [criticalTilt, delta] rw [Real.log_div one_ne_zero log_two_pos.ne', Real.log_one] ring /-- The exponent furnished by Hölder transfer at parameters `lam` and `q`. -/ noncomputable def transferRate (lam q : ℝ) : ℝ := (q * ballotCost lam / Real.log 2 + lam ^ q - 1 - q * (lam - 1)) / (q - 1) /-- First put the tilt at its critical value, then let the Hölder parameter tend to one. -/ theorem tendsto_transferRate_critical : Tendsto (transferRate criticalTilt) (𝓝[>] (1 : ℝ)) (𝓝 delta) := by have hderiv := ((HasDerivAt.const_rpow criticalTilt_pos (hasDerivAt_id (1 : ℝ))).sub_const 1).sub ((hasDerivAt_id (1 : ℝ)).mul_const (criticalTilt - 1)) have hval : Real.log criticalTilt * criticalTilt - (criticalTilt - 1) = delta := by rw [← entropy_critical] ring have ht := hderiv.tendsto_slope.mono_left (nhdsGT_le_nhdsNE (1 : ℝ)) simp only [id_eq, Real.rpow_one, mul_one, one_mul, hval] at ht convert ht using 1 funext q simp only [transferRate, ballotCost_critical, mul_zero, zero_div, zero_add, slope_def_field, Pi.sub_apply, Real.rpow_one, one_mul] ring theorem continuousAt_transferRate (q : ℝ) : ContinuousAt (fun lam ↦ transferRate lam q) criticalTilt := by have hmul : ContinuousAt (fun lam : ℝ ↦ lam * Real.log 2) criticalTilt := continuousAt_id.mul_const _ have hcost : ContinuousAt ballotCost criticalTilt := (hmul.sub_const 1).sub (hmul.log (mul_pos criticalTilt_pos log_two_pos).ne') have hpow := Real.continuousAt_rpow_const criticalTilt q (Or.inl criticalTilt_pos.ne') exact ((((hcost.const_mul q).div_const (Real.log 2)).add hpow).sub_const 1 |>.sub ((continuousAt_id.sub_const 1).const_mul q)).div_const (q - 1) /-- The two limits give admissible fixed parameters with exponent arbitrarily close to `delta`, in the required order of limits. -/ theorem exists_transferRate_lt {ε : ℝ} (hε : 0 < ε) : ∃ lam : ℝ, criticalTilt < lam ∧ lam < 2 ∧ ∃ q : ℝ, 1 < q ∧ transferRate lam q < delta + ε := by have hq : ∀ᶠ q : ℝ in 𝓝[>] (1 : ℝ), transferRate criticalTilt q < delta + ε / 2 := tendsto_transferRate_critical.eventually_lt_const (by linarith) obtain ⟨q, hqrate, hq1⟩ := (hq.and self_mem_nhdsWithin).exists have hlamrate : ∀ᶠ lam : ℝ in 𝓝[>] criticalTilt, transferRate lam q < delta + ε := ((continuousAt_transferRate q).tendsto.eventually_lt_const (by linarith)).filter_mono nhdsWithin_le_nhds have hlam2 : ∀ᶠ lam : ℝ in 𝓝[>] criticalTilt, lam < 2 := (eventually_lt_nhds criticalTilt_lt_two).filter_mono nhdsWithin_le_nhds obtain ⟨lam, hrate, hlt2, hcrit⟩ := (hlamrate.and (hlam2.and self_mem_nhdsWithin)).exists exact ⟨lam, hcrit, hlt2, q, hq1, hrate⟩ /-- The two density estimates used by the final contradiction. Both are proved below. -/ def RequiredDensityEstimates : Prop := atTop.liminf (fun t : ℕ ↦ -Real.log (divisorDensity t) / Real.log (Real.log (t : ℝ))) = delta ∧ Tendsto (fun t : ℕ ↦ Real.log (t : ℝ) ^ delta * divisorDensity t) atTop (𝓝 0) /-- The analytic contradiction from the two density estimates. -/ theorem counterexample_of_estimates (h : RequiredDensityEstimates) : ¬ (fcTypeOfName% "Erdos859.erdos_859") := by obtain ⟨hliminf, hscaled⟩ := h rintro ⟨c, hc, p, _hp, e, he, hequiv⟩ have hde : divisorDensity =ᶠ[atTop] e := by filter_upwards [eventually_gt_atTop 0] with t ht exact tendsto_nhds_unique (divisorSumSet_hasDensity t) (he t ht) have hequiv' : divisorDensity ~[atTop] (fun t ↦ c / Real.log (t : ℝ) ^ p) := hequiv.congr_left hde.symm exact not_equivalent_of_liminf_and_scaled_limit (Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop) hliminf hscaled ⟨c, hc, p, hequiv'⟩ end Erdos859Verification end /- END isolated base development. -/ /- BEGIN verified prime-estimate modules. -/ /- Inlined development module: PrimeMertens.lean -/ section /- Prime reciprocal estimate adapted from the PNT+ project, Apache-2.0. Upstream: AlexKontorovich/PrimeNumberTheoremAnd Commit: a5154676af9aa3095150ee410cdda80555aa0642 File: PrimeNumberTheoremAnd/IEANTN/Mertens.lean Upstream source: https://github.com/AlexKontorovich/PrimeNumberTheoremAnd/ blob/a5154676af9aa3095150ee410cdda80555aa0642/PrimeNumberTheoremAnd/IEANTN/Mertens.lean The upstream Apache-2.0 license is reproduced at the end of this file. Changes: retained only the dependency closure of E₂p.abs_le; removed blueprint metadata; used a larger bound in E₁p.bounded to omit unused sharp estimates; put all declarations in an isolated namespace. Further Lean-version fixes are recorded in the checked source and port notes. -/ namespace Erdos859Verification.PrimeMertens open Real Finset Filter Asymptotics Topology open ArithmeticFunction hiding log lemma sum_Ioc_one_eq_sum_Ioc_zero {f : ℕ → ℝ} {x : ℕ} (hx : 1 ≤ x) (hf : f 1 = 0) : ∑ n ∈ Ioc 1 x, f n = ∑ n ∈ Ioc 0 x, f n := by rw [(by rfl : Ioc 0 x = Icc 1 x), ← add_sum_Ioc_eq_sum_Icc hx] simpa theorem sum_log_le {x : ℝ} (hx : 1 ≤ x) : ∑ n ∈ Ioc 0 ⌊ x ⌋₊, log n ≤ x * log x := by calc _ ≤ ∑ n ∈ Ioc 0 ⌊ x ⌋₊, log x := by refine sum_le_sum fun n hn ↦ ?_ simp only [mem_Ioc] at hn exact log_le_log (by exact_mod_cast hn.1) (Nat.le_floor_iff (by linarith)|>.mp hn.2) _ = ⌊x⌋₊ * log x := by simp _ ≤ _ := by gcongr · exact log_nonneg hx · exact Nat.floor_le (by linarith) lemma integral_log_le {a b : ℝ} (ha : 1 ≤ a) (hab : a ≤ b) : ∫ t in a..b, log t ≤ log b * (b - a) := by apply le_of_abs_le have : ∀ t ∈ Set.uIoc a b, ‖log t‖ ≤ log b := by intro t ht rw [Set.uIoc_of_le hab, Set.mem_Ioc] at ht rw [norm_of_nonneg <| log_nonneg (by linarith)] gcongr <;> linarith grw [← norm_eq_abs, intervalIntegral.norm_integral_le_of_norm_le_const this, abs_of_nonneg (by linarith)] theorem sum_log_ge {x : ℝ} (hx : 1 ≤ x) : ∑ n ∈ Ioc 0 ⌊ x ⌋₊, log n ≥ x * log x - 2 * x := by have one_le_floor : 1 ≤ ⌊x⌋₊ := by simpa calc _ = ∑ n ∈ Icc 1 ⌊ x ⌋₊, log n := by rfl _ = ∑ n ∈ Ico (1 + 1) (⌊ x ⌋₊ + 1), log n := by rw [← add_sum_Ioc_eq_sum_Icc one_le_floor] simp rfl _ = ∑ n ∈ Ico 1 ⌊ x ⌋₊, log ((n + 1 : ℕ)) := by rw [← Finset.sum_Ico_add'] _ ≥ ∫ t in 1..⌊x⌋₊, log t := by convert MonotoneOn.integral_le_sum_Ico one_le_floor ?_|>.ge · norm_cast · exact StrictMonoOn.monotoneOn (strictMonoOn_log.mono fun y hy ↦ (by simp_all; linarith)) _ = (∫ t in 1..x, log t) - ∫ t in ⌊x⌋₊..x, log t := by nth_rw 3 [intervalIntegral.integral_symm] rw [sub_neg_eq_add, intervalIntegral.integral_add_adjacent_intervals] <;> exact intervalIntegral.intervalIntegrable_log' _ ≥ (∫ t in 1..x, log t) - log x := by gcongr grw [integral_log_le (by simpa) (Nat.floor_le (by linarith))] nth_rw 2 [← mul_one (log x)] gcongr · exact log_nonneg hx · linarith [Nat.lt_floor_add_one x] _ ≥ x * log x - x - log x := by simp only [integral_log, log_one, mul_zero, sub_zero, ge_iff_le, tsub_le_iff_right, sub_add_cancel, le_add_iff_nonneg_right, zero_le_one] _ ≥ _ := by linarith [log_le_self (by linarith : 0 ≤ x)] theorem sum_log_eq_sum_mangoldt {x : ℝ} : ∑ n ∈ Ioc 0 ⌊x⌋₊, log n = ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d * ⌊x / d⌋₊ := by have : ∀ n : ℕ, log n = (Λ * zeta) n := by simp [vonMangoldt_mul_zeta] simp_rw [this, sum_Ioc_mul_zeta_eq_sum, ← Nat.floor_div_natCast] noncomputable abbrev E₁Λ (x : ℝ) : ℝ := ∑ d ∈ Ioc 0 ⌊ x ⌋₊, (Λ d) / d - log x theorem E₁Λ.ge {x : ℝ} (hx : 1 ≤ x) : E₁Λ x ≥ -2 := by unfold E₁Λ suffices x * ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d / d ≥ x * (log x - 2) by linarith [le_of_mul_le_mul_left this (by linarith)] calc _ = ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d * (x / d) := by rw [Finset.mul_sum] ring_nf _ ≥ ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d * ⌊x / d⌋₊ := by gcongr exact Nat.floor_le <| div_nonneg (by linarith) (by linarith) _ ≥ x * log x - 2 * x := sum_log_eq_sum_mangoldt ▸ sum_log_ge hx _ = _ := by ring theorem E₁Λ.le {x : ℝ} (hx : 1 ≤ x) : E₁Λ x ≤ log 4 + 4 := by unfold E₁Λ suffices x * ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d / d ≤ x * (log x + log 4 + 4) by linarith [le_of_mul_le_mul_left this (by linarith)] calc _ = ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d * (x / d) := by rw [Finset.mul_sum] ring_nf _ ≤ ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d * (⌊x / d⌋₊ + 1) := by gcongr exact Nat.lt_floor_add_one _|>.le _ = (∑ d ∈ Ioc 0 ⌊x⌋₊, log d) + ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d := by simp_rw [mul_add, mul_one] rw [Finset.sum_add_distrib, sum_log_eq_sum_mangoldt] _ ≤ x * log x + (log 4 + 4) * x := by gcongr · exact sum_log_le hx · exact Chebyshev.psi_le_const_mul_self (by linarith) _ = _ := by ring noncomputable abbrev E₁p (x : ℝ) : ℝ := ∑ p ∈ Ioc 0 ⌊ x ⌋₊ with p.Prime, (log p) / p - log x theorem sum_log_prime_div_eq (x : ℝ) : ∑ p ∈ Ioc 0 ⌊ x ⌋₊ with p.Prime, (log p) / p = log x + E₁p x := by grind theorem E₁p.le_E₁Λ (x : ℝ) : E₁p x ≤ E₁Λ x := by unfold E₁p E₁Λ; rw [sum_filter] gcongr with p _ split_ifs with hp · simp [vonMangoldt_apply_prime hp] have : 0 ≤ Λ p := vonMangoldt_nonneg positivity theorem E₁p.le {x : ℝ} (hx : 1 ≤ x) : E₁p x ≤ log 4 + 4 := by linarith [E₁Λ.le hx, E₁p.le_E₁Λ x] noncomputable abbrev E₁ : ℝ := ∑' p : ℕ, if p.Prime then (log p) / (p*(p-1)) else 0 lemma E₁.summand_nonneg (p : ℕ) : 0 ≤ if p.Prime then (log p) / (p*(p-1)) else 0 := by split_ifs with h · refine div_nonneg (log_natCast_nonneg _) (mul_nonneg (Nat.cast_nonneg _) ?_) suffices 1 ≤ (p : ℝ) by linarith exact_mod_cast h.one_le · rfl theorem E₁.summable : Summable (fun p : ℕ ↦ if p.Prime then (log p) / (p*(p-1)) else 0) := by refine (Real.summable_one_div_nat_rpow.mpr (by norm_num: 1 < (3 : ℝ) / 2)|>.const_div 4).of_nonneg_of_le E₁.summand_nonneg fun n ↦ ?_ split_ifs with h · grw [Real.log_le_rpow_div (Nat.cast_nonneg _) (by norm_num : 0 < (1 : ℝ) / 2)] · have denom : (n : ℝ) * ((n : ℝ) - 1) ≥ n ^ 2/ 2 := by rw [sq, mul_div_assoc] gcongr suffices (n : ℝ) ≥ 2 by linarith exact_mod_cast h.two_le grw [denom] · apply le_of_eq rw [← Real.rpow_natCast] field_simp rw [mul_div_assoc, ← Real.rpow_sub (mod_cast h.pos)] norm_num rw [Real.rpow_neg (Nat.cast_nonneg _)] field · exact div_pos (pow_pos (mod_cast h.pos) _) (by norm_num) · apply mul_nonneg (Nat.cast_nonneg _) suffices 1 ≤ (n : ℝ) by linarith exact_mod_cast h.one_le · positivity theorem E₁.nonneg : E₁ ≥ 0 := tsum_nonneg E₁.summand_nonneg theorem E₁Λ.le_E₁p_add_E₁ {x : ℝ} (hx : 1 ≤ x) : E₁Λ x ≤ E₁p x + E₁ := by unfold E₁Λ E₁p suffices ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d / d ≤ ∑ p ∈ Ioc 0 ⌊x⌋₊ with Nat.Prime p, log p / p + E₁ by linarith simp_rw [vonMangoldt_apply, ite_div, zero_div, ← sum_filter, Chebyshev.sum_PrimePow_eq_sum_sum _ (by linarith)] calc _ = ∑ k ∈ Icc 1 ⌊log x / log 2⌋₊, ∑ p ∈ Ioc 0 ⌊x ^ (1 / (k : ℝ))⌋₊ with Nat.Prime p, log p / (p ^ k : ℕ) := by refine sum_congr rfl fun k hk ↦ sum_congr rfl fun p hp ↦ ?_ rw [Nat.Prime.pow_minFac (by simp_all) (by simp_all; linarith)] _ ≤ ∑ k ∈ Icc 1 ⌊log x / log 2⌋₊, ∑ p ∈ Ioc 0 ⌊x⌋₊ with Nat.Prime p, log p / (p ^ k : ℕ) := by gcongr with k hk apply rpow_le_self_of_one_le hx simp only [mem_Icc] at hk exact div_le_one₀ (by norm_cast; linarith)|>.mpr (mod_cast hk.1) _ ≤ ∑ k ∈ Icc 1 (max 1 ⌊log x / log 2⌋₊), ∑ p ∈ Ioc 0 ⌊x⌋₊ with Nat.Prime p, log p / (p ^ k : ℕ) := by apply sum_le_sum_of_subset_of_nonneg · gcongr exact le_max_right .. · exact fun _ _ _ ↦ sum_nonneg fun _ _ ↦ (by positivity) _ = ∑ p ∈ Ioc 0 ⌊x⌋₊ with Nat.Prime p, (log p / p) + ∑ k ∈ Ioc 1 (max 1 ⌊log x / log 2⌋₊), ∑ p ∈ Ioc 0 ⌊x⌋₊ with Nat.Prime p, log p / (p ^ k : ℕ) := by rw [← add_sum_Ioc_eq_sum_Icc (le_max_left ..)] simp _ ≤ _ := by gcongr rw [sum_comm] conv => lhs; arg 2; ext p; arg 2; ext k; rw [← mul_one_div, Nat.cast_pow, ← one_div_pow] simp_rw [← mul_sum] calc _ ≤ ∑ p ∈ Ioc 0 ⌊x⌋₊ with Nat.Prime p, log p / (p * (p - 1)) := by gcongr with p hp simp only [mem_filter, mem_Ioc] at hp conv => rhs; rw [← mul_one_div] gcongr rw [(by rfl : Ioc 1 (max 1 ⌊log x / log 2⌋₊) = Ico 2 (max 1 ⌊log x / log 2⌋₊ + 1))] grw [geom_sum_Ico_le_of_lt_one (by simp)] · apply le_of_eq have : (p : ℝ) ≠ 0 := by exact_mod_cast hp.1.1.ne.symm field · simpa using inv_lt_one_of_one_lt₀ (mod_cast hp.2.one_lt) _ ≤ _ := by rw [sum_filter] exact E₁.summable.sum_le_tsum _ fun p hp ↦ E₁.summand_nonneg p theorem E₁p.ge {x : ℝ} (hx : 1 ≤ x) : E₁p x ≥ -2 - E₁ := by linarith [E₁Λ.le_E₁p_add_E₁ hx, E₁Λ.ge hx] theorem E₁p.bounded : ∃ c > 0, ∀ x ≥ 1, |E₁p x| ≤ c := by refine ⟨log 4 + 6 + E₁, ?_, ?_⟩ · have := E₁.nonneg have : 0 ≤ log 4 := log_nonneg (by norm_num) linarith · intro x hx have := E₁p.le hx have := E₁p.ge hx have := E₁.nonneg have : 0 ≤ log 4 := log_nonneg (by norm_num) exact abs_le.mpr ⟨by linarith, by linarith⟩ lemma sum_Ioc_one_eq_sum_Icc_zero {f : ℕ → ℝ} {x : ℕ} (hx : 1 ≤ x) (hf1 : f 1 = 0) (hf0 : f 0 = 0) : ∑ n ∈ Ioc 1 x, f n = ∑ n ∈ Icc 0 x, f n := by rw [sum_Ioc_one_eq_sum_Ioc_zero hx hf1, ← add_sum_Ioc_eq_sum_Icc (by linarith)] simpa private theorem sum_div_log_eq {x : ℝ} (hx : 2 ≤ x) (f : ℕ → ℝ) : ∑ n ∈ Ioc 1 ⌊ x ⌋₊, f n / log n = (∑ n ∈ Ioc 1 ⌊ x ⌋₊, f n) / log x + ∫ t in 2..x, (∑ n ∈ Ioc 1 ⌊ t ⌋₊, f n) / (t * log t^2) := by let g : ℕ → ℝ := (fun n ↦ if n < 2 then 0 else f n) trans ∑ n ∈ Icc 0 ⌊ x ⌋₊, (log n)⁻¹ * g n · rw [← sum_Ioc_one_eq_sum_Icc_zero (Nat.le_floor (by grind)) (by simp) (by simp)] refine sum_congr rfl fun n hn ↦ ?_ have : ¬(n ≤ 1) := by simp_all simp [g, this] field rw [sum_mul_eq_sub_integral_mul₁ g (f := (fun n ↦ (log n)⁻¹)) (by simp [g]) (by simp [g])] · rw [intervalIntegral.integral_of_le hx, mul_comm, ← div_eq_mul_inv, ← sub_neg_eq_add] simp_rw [deriv_inv_log] congr 1 · rw [← sum_Ioc_one_eq_sum_Icc_zero (Nat.le_floor (by grind)) (by simp [g]) (by simp [g])] congr 1 refine sum_congr rfl fun n hn ↦ ?_ simp only [mem_Ioc] at hn have : ¬(n ≤ 1) := by linarith simp [g, this] · rw [← MeasureTheory.integral_neg] refine MeasureTheory.setIntegral_congr_fun (by measurability) fun t ht ↦ ?_ simp only [Set.mem_Ioc] at ht rw [← sum_Ioc_one_eq_sum_Icc_zero (Nat.le_floor (by grind)) (by simp [g]) (by simp [g])] field_simp congr 2 refine sum_congr rfl fun n hn ↦ ?_ simp only [mem_Ioc] at hn have : ¬(n ≤ 1) := by linarith simp [g, this] · intro t ht simp only [Set.mem_Icc] at ht have : log t ≠ 0 := by simp; grind fun_prop (disch := grind) · refine ContinuousOn.integrableOn_Icc fun t ht ↦ ContinuousAt.continuousWithinAt ?_ simp only [Set.mem_Icc] at ht conv => arg 1; ext x; rw [deriv_inv_log] have : log t ^2 ≠ 0 := by simp; grind fun_prop (disch := grind) private theorem integrable_const_div_mul_log_sq {x : ℝ} (c : ℝ) (hx : 2 ≤ x) : MeasureTheory.IntegrableOn (fun x ↦ c / (x * log x ^ 2)) (Set.Ioi x) MeasureTheory.volume := by conv => arg 1; ext t; rw [← mul_one_div] apply MeasureTheory.Integrable.const_mul refine MeasureTheory.integrableOn_Ioi_deriv_of_nonneg' ?_ ?_ tendsto_log_atTop.inv_tendsto_atTop.neg · intro t ht simp only [Set.mem_Ici] at ht have : log t ≠ 0 := by simp; grind have : DifferentiableAt ℝ (fun t ↦ -(log t)⁻¹) t := by fun_prop (disch := grind) convert! this.hasDerivAt using 1 simp [deriv_inv_log] field · intro t ht simp only [Set.mem_Ioi] at ht exact one_div_nonneg.mpr <| mul_nonneg (by linarith) (sq_nonneg _) private theorem integrable_E₁p_div_mul_log_sq {x : ℝ} (hx : 2 ≤ x) : MeasureTheory.IntegrableOn (fun x ↦ E₁p x / (x * log x ^ 2)) (Set.Ioi x) MeasureTheory.volume := by obtain ⟨c, hc1, hc2⟩ := E₁p.bounded apply MeasureTheory.Integrable.mono (integrable_const_div_mul_log_sq c hx) · exact Measurable.aestronglyMeasurable (by fun_prop) · filter_upwards [MeasureTheory.ae_restrict_mem (by measurability)] with t ht simp only [Set.mem_Ioi] at ht simp only [norm_div, norm_eq_abs, norm_mul, norm_pow, sq_abs, abs_of_pos hc1] gcongr exact hc2 t (by linarith) lemma deriv_log_log {x : ℝ} (hx : 1 < x) : deriv (fun t ↦ log (log t)) x = 1 / (x * log x) := by rw [deriv.log (differentiableAt_log (by linarith)) (by simp; grind), deriv_log] field lemma integral_one_div_mul_log {x : ℝ} (hx : 2 ≤ x) : ∫ t in 2..x, 1 / (t * log t) = log (log x) - log (log 2) := by rw [← intervalIntegral.integral_deriv_eq_sub (f := fun t ↦ log (log t))] · refine intervalIntegral.integral_congr fun t ht ↦ ?_ rw [deriv_log_log] rw [Set.uIcc_of_le hx, Set.mem_Icc] at ht linarith · intro t ht rw [Set.uIcc_of_le hx, Set.mem_Icc] at ht have : log t ≠ 0 := by simp; grind fun_prop (disch := grind) · refine ContinuousOn.intervalIntegrable ?_ apply ContinuousOn.congr (f := (fun t ↦ 1 / (t * log t))) · refine fun t ht ↦ ContinuousAt.continuousWithinAt ?_ rw [Set.uIcc_of_le hx, Set.mem_Icc] at ht have : log t ≠ 0 := by simp; grind fun_prop (disch := grind) · intro t ht rw [Set.uIcc_of_le hx, Set.mem_Icc] at ht exact deriv_log_log (by linarith) lemma intervalIntegrable_one_div_mul_log {x : ℝ} (hx : 2 ≤ x) : IntervalIntegrable (fun t ↦ 1 / (t * log t)) MeasureTheory.volume 2 x := by refine ContinuousOn.intervalIntegrable fun t ht ↦ ContinuousAt.continuousWithinAt ?_ rw [Set.uIcc_of_le hx, Set.mem_Icc] at ht have : log t ≠ 0 := by simp; grind fun_prop (disch := grind) private theorem integ_div_mul_log_sq {x : ℝ} (c : ℝ) (hx : 2 ≤ x) : ∫ t in Set.Ioi x, c / (t * log t^2) = c / log x := by convert! MeasureTheory.integral_Ioi_of_hasDerivAt_of_tendsto' (m := 0) (f := fun x ↦ - c / log x) ?_ (integrable_const_div_mul_log_sq c hx) ?_ using 1 · grind · intro t ht; simp at ht convert! HasDerivAt.fun_div (hasDerivAt_const _ (-c)) (hasDerivAt_log (by linarith)) ?_ using 1 · grind simp; grind convert! tendsto_log_atTop.inv_tendsto_atTop.const_mul (-c) using 1 simp noncomputable def M : ℝ := (∫ t in Set.Ioi 2, E₁p t / (t * log t^2)) + 1 - log (log 2) noncomputable abbrev E₂p (x : ℝ) : ℝ := ∑ p ∈ Ioc 0 ⌊ x ⌋₊ with p.Prime, (1:ℝ) / p - log (log x) - M theorem sum_prime_div_eq (x : ℝ) : ∑ p ∈ Ioc 0 ⌊ x ⌋₊ with p.Prime, (1:ℝ) / p = log (log x) + M + E₂p x := by ring theorem E₂p.eq {x : ℝ} (hx : 2 ≤ x) : E₂p x = E₁p x / log x - ∫ t in Set.Ioi x, E₁p t / (t * log t^2) := by unfold E₂p rw [sum_filter, ← sum_Ioc_one_eq_sum_Ioc_zero (Nat.le_floor (by grind)) (by simp [Nat.not_prime_one])] have (n : ℕ) : (if Nat.Prime n then (1 : ℝ) / n else 0) = (if Nat.Prime n then log n / n else 0) / log n := by split_ifs with h · have : log n ≠ 0 := by simp; grind [h.two_le] field · simp simp_rw [this] rw [sum_div_log_eq hx, sum_Ioc_one_eq_sum_Ioc_zero (Nat.le_floor (by grind)) (by simp), ← sum_filter] rw [sum_log_prime_div_eq] have : ∫ t in 2..x, (∑ n ∈ Ioc 1 ⌊t⌋₊, if Nat.Prime n then log ↑n / ↑n else 0) / (t * log t ^ 2) = ∫ t in 2..x, (1 / (t * log t) + E₁p t / (t * log t ^2)) := by refine intervalIntegral.integral_congr fun t ht ↦ ?_ rw [Set.uIcc_of_le hx, Set.mem_Icc] at ht rw [sum_Ioc_one_eq_sum_Ioc_zero (Nat.le_floor (by grind)) (by simp), ← sum_filter, sum_log_prime_div_eq] field rw [this, intervalIntegral.integral_add] · rw [integral_one_div_mul_log hx, add_div, div_self (by simp; grind)] unfold M calc _ = E₁p x / log x + (∫ (x : ℝ) in 2..x, E₁p x / (x * log x ^ 2)) - ((∫ (t : ℝ) in Set.Ioi 2, E₁p t / (t * log t ^ 2))) := by ring _ = _ := by rw [← intervalIntegral.integral_interval_add_Ioi (integrable_E₁p_div_mul_log_sq (by rfl)) (integrable_E₁p_div_mul_log_sq hx)] ring · exact intervalIntegrable_one_div_mul_log hx · rw [intervalIntegrable_iff, Set.uIoc_of_le hx] exact integrable_E₁p_div_mul_log_sq (x := 2) (by rfl)|>.mono (by grind) (by rfl) theorem E₂p.abs_le {x : ℝ} (hx : 2 ≤ x) : |E₂p x| ≤ (log 4 + 6 + E₁) / log x := by have : 0 < log x := by apply log_pos; linarith rw [E₂p.eq hx, abs_le'] constructor · grw [E₁p.le (by linarith)] have : ∫ t in Set.Ioi x, E₁p t / (t * log t^2) ≥ (- 2 - E₁) / log x := calc _ ≥ ∫ t in Set.Ioi x, (-2 - E₁) / (t * log t^2) := by apply MeasureTheory.setIntegral_mono_on (integrable_const_div_mul_log_sq (-2 - E₁) hx) (integrable_E₁p_div_mul_log_sq hx) (by measurability) intro y hy; simp at hy have : 1 < y := by linarith have : 0 < log y := log_pos this gcongr; exact E₁p.ge (by linarith) _ = _ := integ_div_mul_log_sq (-2 - E₁) hx grw [this] grind grw [E₁p.ge (by linarith)] have : ∫ t in Set.Ioi x, E₁p t / (t * log t^2) ≤ (log 4 + 4) / log x := calc _ ≤ ∫ t in Set.Ioi x, (log 4 + 4) / (t * log t^2) := by apply MeasureTheory.setIntegral_mono_on (integrable_E₁p_div_mul_log_sq hx) (integrable_const_div_mul_log_sq (log 4 + 4) hx) (by measurability) intro y hy; simp at hy have : 1 < y := by linarith have : 0 < log y := log_pos this gcongr; exact E₁p.le (by linarith) _ = _ := integ_div_mul_log_sq (log 4 + 4) hx grw [this] grind end Erdos859Verification.PrimeMertens end /- Inlined development module: PrimeWindows.lean -/ section /- Reciprocal-prime mass on the logarithmic windows used by the construction. -/ namespace Erdos859Verification open Real Finset Filter open scoped Topology noncomputable def mertensErrorConstant : ℝ := log 4 + 6 + PrimeMertens.E₁ theorem mertensErrorConstant_pos : 0 < mertensErrorConstant := by have := PrimeMertens.E₁.nonneg have : 0 ≤ log 4 := log_nonneg (by norm_num) unfold mertensErrorConstant linarith noncomputable def primeReciprocalSum (x : ℝ) : ℝ := ∑ p ∈ Ioc 0 ⌊x⌋₊ with p.Prime, 1 / (p : ℝ) theorem primeReciprocalSum_estimate {x : ℝ} (hx : 2 ≤ x) : |primeReciprocalSum x - log (log x) - PrimeMertens.M| ≤ mertensErrorConstant / log x := PrimeMertens.E₂p.abs_le hx theorem primeReciprocalSum_sub {x y : ℝ} (hxy : x ≤ y) : (∑ p ∈ Ioc ⌊x⌋₊ ⌊y⌋₊ with p.Prime, 1 / (p : ℝ)) = primeReciprocalSum y - primeReciprocalSum x := by have h := sum_Ioc_consecutive (fun p : ℕ ↦ if p.Prime then 1 / (p : ℝ) else 0) (Nat.zero_le ⌊x⌋₊) (Nat.floor_mono hxy) simp only [← sum_filter] at h unfold primeReciprocalSum linarith theorem primeReciprocalInterval_estimate {x y : ℝ} (hx : 2 ≤ x) (hxy : x ≤ y) : |(∑ p ∈ Ioc ⌊x⌋₊ ⌊y⌋₊ with p.Prime, 1 / (p : ℝ)) - log (log y / log x)| ≤ mertensErrorConstant / log x + mertensErrorConstant / log y := by have hxlog : 0 < log x := log_pos (by linarith) have hylog : 0 < log y := log_pos (by linarith) rw [primeReciprocalSum_sub hxy, log_div hylog.ne' hxlog.ne'] have heq : primeReciprocalSum y - primeReciprocalSum x - (log (log y) - log (log x)) = PrimeMertens.E₂p y - PrimeMertens.E₂p x := by unfold PrimeMertens.E₂p primeReciprocalSum ring rw [heq] calc _ ≤ |PrimeMertens.E₂p y| + |PrimeMertens.E₂p x| := abs_sub _ _ _ ≤ _ := by have := PrimeMertens.E₂p.abs_le hx have := PrimeMertens.E₂p.abs_le (hx.trans hxy) change |PrimeMertens.E₂p y| + |PrimeMertens.E₂p x| ≤ (log 4 + 6 + PrimeMertens.E₁) / log x + (log 4 + 6 + PrimeMertens.E₁) / log y linarith noncomputable def primeLogWindowMass (a b : ℝ) : ℝ := ∑ p ∈ Ioc ⌊exp a⌋₊ ⌊exp b⌋₊ with p.Prime, 1 / (p : ℝ) /-- A fixed ratio of logarithmic endpoints has asymptotically constant prime reciprocal mass, with an explicit error. -/ theorem primeLogWindowMass_estimate {a b : ℝ} (ha : log 2 ≤ a) (hab : a ≤ b) : |primeLogWindowMass a b - log (b / a)| ≤ 2 * mertensErrorConstant / a := by have ha0 : 0 < a := lt_of_lt_of_le (log_pos (by norm_num)) ha have hxa : 2 ≤ exp a := by rw [← exp_log (by norm_num : (0 : ℝ) < 2)] exact exp_le_exp.mpr ha have h := primeReciprocalInterval_estimate hxa (exp_le_exp.mpr hab) simp only [log_exp] at h calc _ ≤ mertensErrorConstant / a + mertensErrorConstant / b := h _ ≤ _ := by have hdiv : mertensErrorConstant / b ≤ mertensErrorConstant / a := div_le_div_of_nonneg_left mertensErrorConstant_pos.le ha0 hab calc _ ≤ mertensErrorConstant / a + mertensErrorConstant / a := add_le_add le_rfl hdiv _ = 2 * mertensErrorConstant / a := by ring end Erdos859Verification end /- Inlined development module: PrimePatterns.lean -/ section /- Exact finite prime-divisibility laws for the lower-bound construction. -/ open Filter Finset open scoped Topology namespace Erdos859Verification theorem primeProduct_dvd_iff {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (n : ℕ) : (∏ p ∈ P, p) ∣ n ↔ ∀ p ∈ P, p ∣ n := by induction P using Finset.induction_on with | empty => simp | @insert p P hp ih => have hprime : p.Prime := hP p (mem_insert_self p P) have hP' : ∀ q ∈ P, q.Prime := fun q hq ↦ hP q (mem_insert_of_mem hq) have hcop : Nat.Coprime p (∏ q ∈ P, q) := by apply Nat.Coprime.prod_right intro q hq apply (Nat.coprime_primes hprime (hP' q hq)).mpr intro heq exact hp (heq ▸ hq) rw [prod_insert hp] constructor · intro hd q hq rcases mem_insert.mp hq with rfl | hq · exact dvd_trans (dvd_mul_right q _) hd · exact (ih hP').mp (dvd_trans (dvd_mul_left _ p) hd) q hq · intro hd exact hcop.mul_dvd_of_dvd_of_dvd (hd p (mem_insert_self p P)) ((ih hP').mpr (fun q hq ↦ hd q (mem_insert_of_mem hq))) theorem primeProduct_indicator {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (n : ℕ) : (∏ p ∈ P, if p ∣ n then (1 : ℝ) else 0) = if (∏ p ∈ P, p) ∣ n then 1 else 0 := by classical by_cases hall : ∀ p ∈ P, p ∣ n · rw [if_pos ((primeProduct_dvd_iff hP n).mpr hall)] exact prod_eq_one (fun p hp ↦ if_pos (hall p hp)) · rw [if_neg (mt (primeProduct_dvd_iff hP n).mp hall)] push Not at hall obtain ⟨p, hp, hpn⟩ := hall exact prod_eq_zero hp (if_neg hpn) /-- All multilinear prime-divisibility moments factor with Bernoulli parameters `1/p`. This is a limit over integers, with no probabilistic independence assumption. -/ theorem tendsto_mean_prime_product {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (a b : ℕ → ℝ) : Tendsto (fun N : ℕ ↦ (∑ n ∈ range N, ∏ p ∈ P, (a p * (if p ∣ n then (1 : ℝ) else 0) + b p)) / N) atTop (𝓝 (∏ p ∈ P, (a p / (p : ℝ) + b p))) := by classical have hexpand (n : ℕ) : (∏ p ∈ P, (a p * (if p ∣ n then (1 : ℝ) else 0) + b p)) = ∑ S ∈ P.powerset, (∏ p ∈ S, a p) * (∏ p ∈ P \ S, b p) * (if (∏ p ∈ S, p) ∣ n then 1 else 0) := by rw [prod_add] apply sum_congr rfl intro S hS have hprime : ∀ p ∈ S, p.Prime := fun p hp ↦ hP p (mem_powerset.mp hS hp) rw [prod_mul_distrib, primeProduct_indicator hprime] ring have heach : ∀ S ∈ P.powerset, Tendsto (fun N : ℕ ↦ (∏ p ∈ S, a p) * (∏ p ∈ P \ S, b p) * ((∑ n ∈ range N, if (∏ p ∈ S, p) ∣ n then (1 : ℝ) else 0) / N)) atTop (𝓝 ((∏ p ∈ S, a p) * (∏ p ∈ P \ S, b p) * (1 / (∏ p ∈ S, p : ℕ)))) := by intro S hS apply Tendsto.const_mul exact tendsto_mean_dvd_indicator (prod_pos (fun p hp ↦ (hP p (mem_powerset.mp hS hp)).pos)) have hsum := tendsto_finsetSum P.powerset heach convert hsum using 1 · funext N simp only [hexpand, sum_div, mul_div_assoc, mul_sum] rw [sum_comm] · apply congrArg nhds rw [prod_add] apply sum_congr rfl intro S _ simp only [prod_div_distrib, Nat.cast_prod] ring /-- An arbitrary pair of real weights at each prime has the corresponding product expectation. -/ theorem tendsto_mean_prime_choices {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (u v : ℕ → ℝ) : Tendsto (fun N : ℕ ↦ (∑ n ∈ range N, ∏ p ∈ P, if p ∣ n then u p else v p) / N) atTop (𝓝 (∏ p ∈ P, (u p / (p : ℝ) + v p * (1 - 1 / (p : ℝ))))) := by convert tendsto_mean_prime_product hP (fun p ↦ u p - v p) v using 1 · funext N congr 1 apply sum_congr rfl intro n _ apply prod_congr rfl intro p _ split_ifs <;> ring · apply congrArg nhds apply prod_congr rfl intro p _ ring /-- Integers with exactly the prescribed prime divisibility pattern on `P`. -/ def PrimePatternSet (P T : Finset ℕ) : Set ℕ := {n | ∀ p ∈ P, p ∣ n ↔ p ∈ T} noncomputable def primePatternWeight (P T : Finset ℕ) : ℝ := ∏ p ∈ P, if p ∈ T then 1 / (p : ℝ) else 1 - 1 / (p : ℝ) /-- The exact finite Bernoulli law, proved from densities of multiples. -/ theorem primePattern_hasDensity {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (T : Finset ℕ) : (PrimePatternSet P T).HasDensity (primePatternWeight P T) := by classical have hmean := tendsto_mean_prime_choices hP (fun p ↦ if p ∈ T then (1 : ℝ) else 0) (fun p ↦ if p ∈ T then (0 : ℝ) else 1) have hw : (∏ p ∈ P, ((if p ∈ T then (1 : ℝ) else 0) / p + (if p ∈ T then (0 : ℝ) else 1) * (1 - 1 / p))) = primePatternWeight P T := by apply prod_congr rfl intro p _ split_ifs <;> simp rw [hw] at hmean apply hasDensity_of_indicator_mean hmean apply Filter.Eventually.of_forall intro n simp only [Set.indicator_apply, PrimePatternSet, Set.mem_ofPred_eq] rw [← Finset.prod_boole] apply prod_congr rfl intro p _ by_cases hp : p ∣ n <;> by_cases hT : p ∈ T <;> simp [hp, hT] end Erdos859Verification end /- Inlined development module: PrimeLaw.lean -/ section /- Exact finite expectations and normalizers for prime tilting. -/ open Filter Finset open scoped Topology namespace Erdos859Verification theorem primePattern_mem_iff {P T : Finset ℕ} (hT : T ⊆ P) (n : ℕ) : n ∈ PrimePatternSet P T ↔ P.filter (fun p ↦ p ∣ n) = T := by constructor · intro h apply Finset.ext intro p constructor · intro hp exact (h p (mem_filter.mp hp).1).mp (mem_filter.mp hp).2 · intro hp exact mem_filter.mpr ⟨hT hp, (h p (hT hp)).mpr hp⟩ · intro h p hp constructor · intro hd rw [← h] exact mem_filter.mpr ⟨hp, hd⟩ · intro ht rw [← h] at ht exact (mem_filter.mp ht).2 theorem primePatternWeight_split {P T : Finset ℕ} (hT : T ⊆ P) : primePatternWeight P T = (∏ p ∈ T, 1 / (p : ℝ)) * ∏ p ∈ P \ T, (1 - 1 / (p : ℝ)) := by classical unfold primePatternWeight rw [prod_ite] have hyes : P.filter (fun p ↦ p ∈ T) = T := by ext p simp only [mem_filter] exact and_iff_right_of_imp (fun hp ↦ hT hp) have hno : P.filter (fun p ↦ p ∉ T) = P \ T := by ext p simp rw [hyes, hno] /-- An arbitrary observable on the selected finite prime set has exactly the expectation dictated by the product Bernoulli weights. -/ theorem tendsto_mean_prime_observable {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (F : Finset ℕ → ℝ) : Tendsto (fun N : ℕ ↦ (∑ n ∈ range N, F (P.filter (fun p ↦ p ∣ n))) / N) atTop (𝓝 (∑ T ∈ P.powerset, primePatternWeight P T * F T)) := by classical have hdecomp (n : ℕ) : F (P.filter (fun p ↦ p ∣ n)) = ∑ T ∈ P.powerset, (PrimePatternSet P T).indicator (fun _ ↦ (1 : ℝ)) n * F T := by rw [sum_eq_single (P.filter (fun p ↦ p ∣ n))] · have hn : n ∈ PrimePatternSet P (P.filter (fun p ↦ p ∣ n)) := (primePattern_mem_iff (filter_subset _ _) n).mpr rfl simp [hn] · intro T hT hne have hn : n ∉ PrimePatternSet P T := by rw [primePattern_mem_iff (mem_powerset.mp hT) n] exact fun heq ↦ hne heq.symm simp [hn] · intro hn exact False.elim (hn (mem_powerset.mpr (filter_subset _ _))) have heach : ∀ T ∈ P.powerset, Tendsto (fun N : ℕ ↦ ((∑ n ∈ range N, (PrimePatternSet P T).indicator (fun _ ↦ (1 : ℝ)) n) / N) * F T) atTop (𝓝 (primePatternWeight P T * F T)) := by intro T _ have ht := primePattern_hasDensity hP T change Tendsto (fun N ↦ (PrimePatternSet P T).partialDensity Set.univ N) atTop (𝓝 (primePatternWeight P T)) at ht simp_rw [partialDensity_eq_indicator_mean] at ht exact ht.mul_const (F T) convert tendsto_finsetSum P.powerset heach using 1 funext N simp only [hdecomp, sum_div, div_mul_eq_mul_div, sum_mul] rw [sum_comm] theorem primePatternWeight_pos {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (T : Finset ℕ) : 0 < primePatternWeight P T := by apply prod_pos intro p hp have hp0 : (0 : ℝ) < p := by exact_mod_cast (hP p hp).pos have hp1 : (1 : ℝ) < p := by exact_mod_cast (hP p hp).one_lt split_ifs · positivity · exact sub_pos.mpr ((div_lt_one hp0).mpr hp1) noncomputable def primeTiltNormalizer (P : Finset ℕ) (lam : ℝ) : ℝ := ∏ p ∈ P, (1 + (lam - 1) / (p : ℝ)) /-- Exact moment generating identity, valid before taking any asymptotic or making any approximation to the prime distribution. -/ theorem primePatternWeight_moment (P : Finset ℕ) (lam : ℝ) : ∑ T ∈ P.powerset, primePatternWeight P T * lam ^ T.card = primeTiltNormalizer P lam := by classical unfold primeTiltNormalizer have heq (p : ℕ) : 1 + (lam - 1) / (p : ℝ) = lam / (p : ℝ) + (1 - 1 / (p : ℝ)) := by ring simp_rw [heq] rw [prod_add] apply sum_congr rfl intro T hT rw [primePatternWeight_split (mem_powerset.mp hT)] simp only [prod_div_distrib, prod_const, one_pow] ring theorem sum_primePatternWeight (P : Finset ℕ) : ∑ T ∈ P.powerset, primePatternWeight P T = 1 := by simpa [primeTiltNormalizer] using primePatternWeight_moment P 1 theorem primeTiltNormalizer_pos {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) : 0 < primeTiltNormalizer P lam := by apply prod_pos intro p hp have hp0 : (0 : ℝ) < p := by exact_mod_cast (hP p hp).pos have hp1 : (1 : ℝ) < p := by exact_mod_cast (hP p hp).one_lt have heq : 1 + (lam - 1) / (p : ℝ) = (lam + p - 1) / p := by field_simp ring rw [heq] apply div_pos _ hp0 linarith noncomputable def primeTiltWeight (P : Finset ℕ) (lam : ℝ) (T : Finset ℕ) : ℝ := primePatternWeight P T * lam ^ T.card / primeTiltNormalizer P lam theorem sum_primeTiltWeight {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) : ∑ T ∈ P.powerset, primeTiltWeight P lam T = 1 := by simp only [primeTiltWeight, ← sum_div, primePatternWeight_moment] exact div_self (primeTiltNormalizer_pos hP hlam).ne' end Erdos859Verification end /- Inlined development module: PrimeTransfer.lean -/ section /- Transfer finite prime-set constructions to actual divisor-sum density. -/ open Filter Finset open scoped Topology namespace Erdos859Verification theorem divisorSumSet_of_dvd {t m n : ℕ} (hmn : m ∣ n) (hn : n ≠ 0) (hm : m ∈ Erdos859.DivisorSumSet t) : n ∈ Erdos859.DivisorSumSet t := by obtain ⟨S, hS, hsum⟩ := hm refine ⟨S, ?_, hsum⟩ intro d hd exact Nat.mem_divisors.mpr ⟨dvd_trans (Nat.mem_divisors.mp (hS hd)).1 hmn, hn⟩ theorem tendsto_mean_congr_eventually {f g : ℕ → ℝ} {a : ℝ} (hf : Tendsto (fun N : ℕ ↦ (∑ n ∈ range N, f n) / N) atTop (𝓝 a)) (hfg : f =ᶠ[atTop] g) : Tendsto (fun N : ℕ ↦ (∑ n ∈ range N, g n) / N) atTop (𝓝 a) := by have hdiff : Tendsto (fun n ↦ g n - f n) atTop (𝓝 0) := by apply tendsto_const_nhds.congr' filter_upwards [hfg] with n hn simp [hn] have h := hdiff.cesaro.add hf convert h using 1 · funext N simp only [sum_sub_distrib, div_eq_mul_inv] ring · simp /-- If a finite-prime observable is supported on represented targets, its exact Bernoulli expectation is a lower bound for the target density. -/ theorem prime_observable_le_divisorDensity {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (t : ℕ) (F : Finset ℕ → ℝ) (hF1 : ∀ T, F T ≤ 1) (hsupport : ∀ T ∈ P.powerset, 0 < F T → (∏ p ∈ T, p) ∈ Erdos859.DivisorSumSet t) : (∑ T ∈ P.powerset, primePatternWeight P T * F T) ≤ divisorDensity t := by classical let f : ℕ → ℝ := fun n ↦ if n = 0 then 0 else F (P.filter (fun p ↦ p ∣ n)) have hmean := tendsto_mean_congr_eventually (tendsto_mean_prime_observable hP F) (show (fun n ↦ F (P.filter (fun p ↦ p ∣ n))) =ᶠ[atTop] f by filter_upwards [eventually_gt_atTop 0] with n hn simp [f, hn.ne']) have hdensity := divisorSumSet_hasDensity t change Tendsto (fun N ↦ (Erdos859.DivisorSumSet t).partialDensity Set.univ N) atTop (𝓝 (divisorDensity t)) at hdensity simp_rw [partialDensity_eq_indicator_mean] at hdensity apply le_of_tendsto_of_tendsto' hmean hdensity intro N apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg N) apply sum_le_sum intro n _ by_cases hn : n = 0 · simp only [f, if_pos hn, Set.indicator_apply] split_ifs <;> norm_num · have hf : f n = F (P.filter (fun p ↦ p ∣ n)) := by simp [f, hn] rw [hf] by_cases hpos : 0 < F (P.filter (fun p ↦ p ∣ n)) · have hrep := hsupport (P.filter (fun p ↦ p ∣ n)) (mem_powerset.mpr (filter_subset _ _)) hpos have hdvd : (∏ p ∈ P.filter (fun p ↦ p ∣ n), p) ∣ n := by apply (primeProduct_dvd_iff (fun p hp ↦ hP p (mem_filter.mp hp).1) n).mpr exact fun p hp ↦ (mem_filter.mp hp).2 have hnrep := divisorSumSet_of_dvd hdvd hn hrep simp only [Set.indicator_of_mem hnrep] exact hF1 _ · have hle := le_of_not_gt hpos simp only [Set.indicator_apply] split_ifs <;> linarith noncomputable def primeTiltLikelihood (P : Finset ℕ) (lam : ℝ) (T : Finset ℕ) : ℝ := lam ^ T.card / primeTiltNormalizer P lam /-- Exact likelihood moment under the original finite Bernoulli law. -/ theorem primeTiltLikelihood_moment {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (q : ℝ) : (∑ T ∈ P.powerset, primePatternWeight P T * primeTiltLikelihood P lam T ^ q) = primeTiltNormalizer P (lam ^ q) / primeTiltNormalizer P lam ^ q := by unfold primeTiltLikelihood have hZ := primeTiltNormalizer_pos hP hlam have heach (T : Finset ℕ) : primePatternWeight P T * (lam ^ T.card / primeTiltNormalizer P lam) ^ q = (primePatternWeight P T * (lam ^ q) ^ T.card) / primeTiltNormalizer P lam ^ q := by rw [Real.div_rpow (pow_nonneg hlam.le _) hZ.le, ← Real.rpow_pow_comm hlam.le] ring simp_rw [heach] rw [← sum_div, primePatternWeight_moment] /-- Fully finite Hölder transfer to the actual density. The remaining construction must supply a large tilted expectation on the left. -/ theorem prime_tilt_density_transfer {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (t : ℕ) (F : Finset ℕ → ℝ) (hF0 : ∀ T, 0 ≤ F T) (hF1 : ∀ T, F T ≤ 1) (hsupport : ∀ T ∈ P.powerset, 0 < F T → (∏ p ∈ T, p) ∈ Erdos859.DivisorSumSet t) {lam q : ℝ} (hlam : 0 < lam) (hq : 1 ≤ q) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * F T) ≤ divisorDensity t ^ (1 - q⁻¹) * (primeTiltNormalizer P (lam ^ q) / primeTiltNormalizer P lam ^ q) ^ q⁻¹ := by have hw : ∀ T, 0 ≤ primePatternWeight P T := fun T ↦ (primePatternWeight_pos hP T).le have hL : ∀ T, 0 ≤ primeTiltLikelihood P lam T := by intro T exact div_nonneg (pow_nonneg hlam.le _) (primeTiltNormalizer_pos hP hlam).le have h := holder_tilt_bound P.powerset hq (primePatternWeight P) F (primeTiltLikelihood P lam) hw hF0 hF1 hL have heq (T : Finset ℕ) : primePatternWeight P T * F T * primeTiltLikelihood P lam T = primeTiltWeight P lam T * F T := by unfold primeTiltLikelihood primeTiltWeight ring simp_rw [heq] at h rw [primeTiltLikelihood_moment hP hlam] at h refine h.trans (mul_le_mul_of_nonneg_right ?_ (Real.rpow_nonneg (div_nonneg (primeTiltNormalizer_pos hP (Real.rpow_pos_of_pos hlam q)).le (Real.rpow_nonneg (primeTiltNormalizer_pos hP hlam).le q)) _)) apply Real.rpow_le_rpow · exact sum_nonneg (fun T _ ↦ mul_nonneg (hw T) (hF0 T)) · exact prime_observable_le_divisorDensity hP t F hF1 hsupport · have hinv : q⁻¹ ≤ (1 : ℝ) := by simpa using one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 1) hq linarith end Erdos859Verification end /- Inlined development module: TiltEstimates.lean -/ section /- Uniform logarithmic estimates for the finite prime-tilt normalizer. -/ open Finset Real namespace Erdos859Verification theorem abs_log_one_add_sub_le_sq {x : ℝ} (hx : 0 ≤ x) : |log (1 + x) - x| ≤ x ^ 2 := by have hpos : 0 < 1 + x := by linarith have hu := log_le_sub_one_of_pos hpos have hl := one_sub_inv_le_log_of_pos hpos have hidentity : 1 - (1 + x)⁻¹ - (x - x ^ 2) = x ^ 3 / (1 + x) := by field_simp ring have hr : 0 ≤ 1 - (1 + x)⁻¹ - (x - x ^ 2) := by rw [hidentity] positivity exact abs_le.mpr ⟨by linarith, by nlinarith [sq_nonneg x]⟩ noncomputable def reciprocalSquareBound : ℝ := ∑' n : ℕ, 1 / (n : ℝ) ^ 2 theorem reciprocalSquareBound_nonneg : 0 ≤ reciprocalSquareBound := tsum_nonneg (fun n ↦ by positivity) theorem sum_reciprocalSquare_le (P : Finset ℕ) : (∑ p ∈ P, 1 / (p : ℝ) ^ 2) ≤ reciprocalSquareBound := (Real.summable_one_div_nat_pow.mpr (by norm_num : 1 < (2 : ℕ))).sum_le_tsum P (fun _ _ ↦ by positivity) /-- The product normalizer has a logarithm equal to its linear prime sum, up to a constant independent of the finite prime set. -/ theorem log_primeTiltNormalizer_error (P : Finset ℕ) {lam : ℝ} (hlam : 1 ≤ lam) : |log (primeTiltNormalizer P lam) - (lam - 1) * ∑ p ∈ P, 1 / (p : ℝ)| ≤ (lam - 1) ^ 2 * reciprocalSquareBound := by have hu (p : ℕ) : 0 ≤ (lam - 1) / (p : ℝ) := div_nonneg (sub_nonneg.mpr hlam) (Nat.cast_nonneg p) have hf (p : ℕ) (_hp : p ∈ P) : 1 + (lam - 1) / (p : ℝ) ≠ 0 := by have := hu p linarith unfold primeTiltNormalizer rw [Real.log_prod hf] simp only [mul_sum, mul_one_div] rw [← sum_sub_distrib] calc _ ≤ ∑ p ∈ P, |log (1 + (lam - 1) / (p : ℝ)) - (lam - 1) / p| := abs_sum_le_sum_abs _ _ _ ≤ ∑ p ∈ P, ((lam - 1) / (p : ℝ)) ^ 2 := sum_le_sum (fun p _ ↦ abs_log_one_add_sub_le_sq (hu p)) _ = (lam - 1) ^ 2 * ∑ p ∈ P, 1 / (p : ℝ) ^ 2 := by simp only [mul_sum, div_pow, mul_one_div] _ ≤ _ := mul_le_mul_of_nonneg_left (sum_reciprocalSquare_le P) (sq_nonneg _) noncomputable def primeLogWindow (a b : ℝ) : Finset ℕ := (Ioc ⌊exp a⌋₊ ⌊exp b⌋₊).filter Nat.Prime theorem primeLogWindow_prime (a b : ℝ) : ∀ p ∈ primeLogWindow a b, p.Prime := fun _ hp ↦ (mem_filter.mp hp).2 theorem log_primeWindowTilt_error {a b lam : ℝ} (ha : log 2 ≤ a) (hab : a ≤ b) (hlam : 1 ≤ lam) : |log (primeTiltNormalizer (primeLogWindow a b) lam) - (lam - 1) * log (b / a)| ≤ (lam - 1) ^ 2 * reciprocalSquareBound + (lam - 1) * (2 * mertensErrorConstant / a) := by have hsplit : log (primeTiltNormalizer (primeLogWindow a b) lam) - (lam - 1) * log (b / a) = (log (primeTiltNormalizer (primeLogWindow a b) lam) - (lam - 1) * primeLogWindowMass a b) + (lam - 1) * (primeLogWindowMass a b - log (b / a)) := by ring rw [hsplit] calc _ ≤ |log (primeTiltNormalizer (primeLogWindow a b) lam) - (lam - 1) * primeLogWindowMass a b| + |(lam - 1) * (primeLogWindowMass a b - log (b / a))| := abs_add_le _ _ _ ≤ _ := by rw [abs_mul, abs_of_nonneg (sub_nonneg.mpr hlam)] exact add_le_add (log_primeTiltNormalizer_error (primeLogWindow a b) hlam) (mul_le_mul_of_nonneg_left (primeLogWindowMass_estimate ha hab) (sub_nonneg.mpr hlam)) end Erdos859Verification end /- Inlined development module: PrimeWindowBounds.lean -/ section /- Quantitative upper and lower reciprocal mass bounds for prime windows. -/ open Real namespace Erdos859Verification theorem primeLogWindowMass_upper {a b : ℝ} (ha : log 2 ≤ a) (hab : a ≤ b) : primeLogWindowMass a b ≤ (b - a + 2 * mertensErrorConstant) / a := by have ha0 : 0 < a := lt_of_lt_of_le (log_pos (by norm_num)) ha have hb0 : 0 < b := ha0.trans_le hab have hlog : log (b / a) ≤ (b - a) / a := by have h := log_le_sub_one_of_pos (div_pos hb0 ha0) convert h using 1 field_simp have h := (abs_le.mp (primeLogWindowMass_estimate ha hab)).2 calc _ ≤ log (b / a) + 2 * mertensErrorConstant / a := by linarith _ ≤ (b - a) / a + 2 * mertensErrorConstant / a := add_le_add hlog le_rfl _ = _ := by ring /-- On every sufficiently high dyadic logarithmic band the reciprocal mass is bounded below uniformly. -/ theorem primeLogWindowMass_dyadic_lower {a : ℝ} (ha : log 2 ≤ a) (hlarge : 4 * mertensErrorConstant ≤ a * log 2) : log 2 / 2 ≤ primeLogWindowMass a (2 * a) := by have ha0 : 0 < a := lt_of_lt_of_le (log_pos (by norm_num)) ha have h := primeLogWindowMass_estimate ha (show a ≤ 2 * a by linarith) have hr : 2 * a / a = (2 : ℝ) := by field_simp rw [hr] at h have herr : 2 * mertensErrorConstant / a ≤ log 2 / 2 := by apply (div_le_iff₀ ha0).mpr nlinarith have hlow := (abs_le.mp h).1 linarith end Erdos859Verification end /- Inlined development module: TiltAsymptotics.lean -/ section /- Asymptotic likelihood cost on increasing families of logarithmic bands. -/ open Filter Real Finset open scoped Topology namespace Erdos859Verification /-- The lower logarithmic endpoint may vary arbitrarily above `log 2`. The main term depends only on the number of dyadic logarithmic bands. -/ theorem tendsto_log_primeWindowTilt_div (A : ℕ → ℝ) (hA : ∀ n, log 2 ≤ A n) {lam : ℝ} (hlam : 1 ≤ lam) : Tendsto (fun n : ℕ ↦ log (primeTiltNormalizer (primeLogWindow (A n) (A n * (2 : ℝ) ^ n)) lam) / n) atTop (𝓝 ((lam - 1) * log 2)) := by let C : ℝ := (lam - 1) ^ 2 * reciprocalSquareBound + (lam - 1) * (2 * mertensErrorConstant / log 2) have hlog2 : 0 < log 2 := log_pos (by norm_num) have hbound (n : ℕ) : |log (primeTiltNormalizer (primeLogWindow (A n) (A n * (2 : ℝ) ^ n)) lam) - (n : ℝ) * ((lam - 1) * log 2)| ≤ C := by have hAn : 0 < A n := hlog2.trans_le (hA n) have hab : A n ≤ A n * (2 : ℝ) ^ n := le_mul_of_one_le_right hAn.le (one_le_pow₀ (by norm_num)) have h := log_primeWindowTilt_error (hA n) hab hlam have hr : A n * (2 : ℝ) ^ n / A n = (2 : ℝ) ^ n := by field_simp rw [hr, log_pow] at h have herr : 2 * mertensErrorConstant / A n ≤ 2 * mertensErrorConstant / log 2 := div_le_div_of_nonneg_left (by positivity [mertensErrorConstant_pos]) hlog2 (hA n) calc _ = |log (primeTiltNormalizer (primeLogWindow (A n) (A n * (2 : ℝ) ^ n)) lam) - (lam - 1) * ((n : ℝ) * log 2)| := by congr 1; ring _ ≤ (lam - 1) ^ 2 * reciprocalSquareBound + (lam - 1) * (2 * mertensErrorConstant / A n) := h _ ≤ C := add_le_add le_rfl (mul_le_mul_of_nonneg_left herr (sub_nonneg.mpr hlam)) have hzero : Tendsto (fun n : ℕ ↦ log (primeTiltNormalizer (primeLogWindow (A n) (A n * (2 : ℝ) ^ n)) lam) / n - (lam - 1) * log 2) atTop (𝓝 0) := by apply squeeze_zero_norm' _ (tendsto_const_div_atTop_nhds_zero_nat C) filter_upwards [eventually_gt_atTop 0] with n hn have hnR : (0 : ℝ) < n := by exact_mod_cast hn have heq : log (primeTiltNormalizer (primeLogWindow (A n) (A n * (2 : ℝ) ^ n)) lam) / n - (lam - 1) * log 2 = (log (primeTiltNormalizer (primeLogWindow (A n) (A n * (2 : ℝ) ^ n)) lam) - (n : ℝ) * ((lam - 1) * log 2)) / n := by field_simp rw [Real.norm_eq_abs, heq, abs_div, abs_of_pos hnR] exact div_le_div_of_nonneg_right (hbound n) hnR.le exact tendsto_sub_nhds_zero_iff.mp hzero /-- The exact likelihood moment has the exponential cost used in the manuscript's Hölder calculation. -/ theorem tendsto_log_primeTiltLikelihood_moment_div (A : ℕ → ℝ) (hA : ∀ n, log 2 ≤ A n) {lam q : ℝ} (hlam : 1 ≤ lam) (hq : 0 ≤ q) : Tendsto (fun n : ℕ ↦ log (∑ T ∈ (primeLogWindow (A n) (A n * (2 : ℝ) ^ n)).powerset, primePatternWeight (primeLogWindow (A n) (A n * (2 : ℝ) ^ n)) T * primeTiltLikelihood (primeLogWindow (A n) (A n * (2 : ℝ) ^ n)) lam T ^ q) / n) atTop (𝓝 ((lam ^ q - 1 - q * (lam - 1)) * log 2)) := by have hlam0 : 0 < lam := zero_lt_one.trans_le hlam have hpow : 1 ≤ lam ^ q := Real.one_le_rpow hlam hq have h1 := tendsto_log_primeWindowTilt_div A hA hpow have h2 := (tendsto_log_primeWindowTilt_div A hA hlam).const_mul q have h := h1.sub h2 convert h using 1 · funext n let P := primeLogWindow (A n) (A n * (2 : ℝ) ^ n) have hP : ∀ p ∈ P, p.Prime := primeLogWindow_prime _ _ have hZ := primeTiltNormalizer_pos hP hlam0 have hZq := primeTiltNormalizer_pos hP (Real.rpow_pos_of_pos hlam0 q) change log (∑ T ∈ P.powerset, primePatternWeight P T * primeTiltLikelihood P lam T ^ q) / n = log (primeTiltNormalizer P (lam ^ q)) / n - q * (log (primeTiltNormalizer P lam) / n) rw [primeTiltLikelihood_moment hP hlam0, log_div hZq.ne' (Real.rpow_pos_of_pos hZ q).ne', log_rpow hZ] ring · apply congrArg nhds ring end Erdos859Verification end /- Inlined development module: PracticalChain.lean -/ section /- A deterministic practical seed from separated geometric prime windows. -/ open Finset Real namespace Erdos859Verification def practicalChainProduct (p : ℕ → ℕ) (j : ℕ) : ℕ := 210 * ∏ i ∈ range j, p i theorem practicalChainProduct_succ (p : ℕ → ℕ) (j : ℕ) : practicalChainProduct p (j + 1) = practicalChainProduct p j * p j := by simp only [practicalChainProduct, prod_range_succ, mul_assoc] theorem four_le_log_210 : (4 : ℝ) ≤ log 210 := by apply (le_log_iff_exp_le (by norm_num : (0 : ℝ) < 210)).mpr have he : exp (4 : ℝ) = exp 1 ^ (4 : ℕ) := by simp only [← exp_nat_mul, Nat.cast_ofNat, mul_one] rw [he] calc _ ≤ (3 : ℝ) ^ (4 : ℕ) := pow_le_pow_left₀ (exp_pos _).le exp_one_lt_three.le 4 _ ≤ 210 := by norm_num theorem log_seven_lt_three : log (7 : ℝ) < 3 := by apply (log_lt_iff_lt_exp (by norm_num : (0 : ℝ) < 7)).mpr have he : exp (3 : ℝ) = exp 1 ^ (3 : ℕ) := by simp only [← exp_nat_mul, Nat.cast_ofNat, mul_one] rw [he] calc (7 : ℝ) < 2 ^ (3 : ℕ) := by norm_num _ ≤ _ := pow_le_pow_left₀ (by norm_num) exp_one_gt_two.le 3 theorem coprime_210_of_prime_gt_seven {p : ℕ} (hp : p.Prime) (h7 : 7 < p) : Nat.Coprime 210 p := by have h2 : Nat.Coprime 2 p := (Nat.coprime_primes (by norm_num) hp).mpr (by omega) have h3 : Nat.Coprime 3 p := (Nat.coprime_primes (by norm_num) hp).mpr (by omega) have h5 : Nat.Coprime 5 p := (Nat.coprime_primes (by norm_num) hp).mpr (by omega) have h7' : Nat.Coprime 7 p := (Nat.coprime_primes (by norm_num) hp).mpr (by omega) exact (h2.mul_left h3).mul_left h5 |>.mul_left h7' theorem prime_window_strictMono {p : ℕ → ℕ} {N : ℕ} (hprime : ∀ j < N, (p j).Prime) (hlo : ∀ j < N, 3 * ((3 : ℝ) / 2) ^ j ≤ log (p j)) (hhi : ∀ j < N, log (p j) ≤ 4 * ((3 : ℝ) / 2) ^ j) {i j : ℕ} (hij : i < j) (hj : j < N) : p i < p j := by have hipos : (0 : ℝ) < p i := by exact_mod_cast (hprime i (hij.trans hj)).pos have hjpos : (0 : ℝ) < p j := by exact_mod_cast (hprime j hj).pos apply Nat.cast_lt.mp ((log_lt_log_iff hipos hjpos).mp ?_) have hpow : ((3 : ℝ) / 2) ^ (i + 1) ≤ ((3 : ℝ) / 2) ^ j := pow_le_pow_right₀ (by norm_num) (Nat.succ_le_of_lt hij) rw [pow_succ] at hpow have hpos : 0 < ((3 : ℝ) / 2) ^ i := by positivity have hupper := hhi i (hij.trans hj) have hlower := hlo j hj nlinarith /-- Every selection of one prime per window produces a practical product. The size invariant also ensures that each new prime is at most the current product, which will control the overshoot at the stopping threshold. -/ theorem practicalChain_of_log_windows {p : ℕ → ℕ} {N : ℕ} (hprime : ∀ j < N, (p j).Prime) (hlo : ∀ j < N, 3 * ((3 : ℝ) / 2) ^ j ≤ log (p j)) (hhi : ∀ j < N, log (p j) ≤ 4 * ((3 : ℝ) / 2) ^ j) : ∀ j ≤ N, Nat.IsPractical (practicalChainProduct p j) ∧ 0 < practicalChainProduct p j ∧ 4 * ((3 : ℝ) / 2) ^ j ≤ log (practicalChainProduct p j) := by intro j induction j with | zero => intro _ simpa [practicalChainProduct] using (show Nat.IsPractical 210 ∧ 0 < (210 : ℕ) ∧ (4 : ℝ) ≤ log 210 from ⟨practical_210, by norm_num, four_le_log_210⟩) | succ j ih => intro hj have hjN : j < N := by omega obtain ⟨hpractical, hprodpos, hsize⟩ := ih (by omega) have hnew : p j ≤ practicalChainProduct p j := by apply Nat.cast_le.mp ((log_le_log_iff (by exact_mod_cast (hprime j hjN).pos) (by exact_mod_cast hprodpos)).mp ?_) exact (hhi j hjN).trans hsize have h7 : 7 < p j := by have hpow : (1 : ℝ) ≤ ((3 : ℝ) / 2) ^ j := one_le_pow₀ (by norm_num) have hlog : log (7 : ℝ) < log (p j) := by have := hlo j hjN linarith [log_seven_lt_three] exact Nat.cast_lt.mp ((log_lt_log_iff (by norm_num) (by exact_mod_cast (hprime j hjN).pos)).mp hlog) have hcop : Nat.Coprime (practicalChainProduct p j) (p j) := by apply Nat.Coprime.mul_left (coprime_210_of_prime_gt_seven (hprime j hjN) h7) apply Nat.Coprime.prod_left intro i hi exact (Nat.coprime_primes (hprime i ((mem_range.mp hi).trans hjN)) (hprime j hjN)).mpr (prime_window_strictMono hprime hlo hhi (mem_range.mp hi) hjN).ne rw [practicalChainProduct_succ] refine ⟨practical_mul_prime hpractical (hprime j hjN) hcop (by omega), Nat.mul_pos hprodpos (hprime j hjN).pos, ?_⟩ rw [Nat.cast_mul, log_mul (by exact_mod_cast hprodpos.ne') (by exact_mod_cast (hprime j hjN).ne_zero), pow_succ] have := hlo j hjN have hnonneg : 0 ≤ ((3 : ℝ) / 2) ^ j := by positivity nlinarith theorem exists_threshold_crossing {f : ℕ → ℕ} {Z N : ℕ} (hzero : f 0 < Z) (hlarge : Z ≤ f N) : ∃ j < N, f j < Z ∧ Z ≤ f (j + 1) := by induction N with | zero => omega | succ N ih => by_cases hN : Z ≤ f N · obtain ⟨j, hj, hsmall, hbig⟩ := ih hN exact ⟨j, by omega, hsmall, hbig⟩ · exact ⟨N, by omega, by omega, hlarge⟩ /-- Stopping at the first crossing gives a practical seed in `[Z,Z²)`, using only primes less than `Z` before that crossing. -/ theorem exists_practicalSeed_from_windows {p : ℕ → ℕ} {N Z : ℕ} (hprime : ∀ j < N, (p j).Prime) (hlo : ∀ j < N, 3 * ((3 : ℝ) / 2) ^ j ≤ log (p j)) (hhi : ∀ j < N, log (p j) ≤ 4 * ((3 : ℝ) / 2) ^ j) (hZ : 210 < Z) (hlarge : log (Z : ℝ) ≤ 4 * ((3 : ℝ) / 2) ^ N) : ∃ j < N, Nat.IsPractical (practicalChainProduct p (j + 1)) ∧ Z ≤ practicalChainProduct p (j + 1) ∧ practicalChainProduct p (j + 1) < Z ^ 2 ∧ p j < Z := by have hchain := practicalChain_of_log_windows hprime hlo hhi obtain ⟨_, hNpos, hNsize⟩ := hchain N le_rfl have hlast : Z ≤ practicalChainProduct p N := by apply Nat.cast_le.mp ((log_le_log_iff (by exact_mod_cast (by omega : 0 < Z)) (by exact_mod_cast hNpos)).mp (hlarge.trans hNsize)) obtain ⟨j, hj, hsmall, hbig⟩ := exists_threshold_crossing (show practicalChainProduct p 0 < Z by simpa [practicalChainProduct] using hZ) hlast obtain ⟨_, hjpos, hjsize⟩ := hchain j hj.le have hnew : p j ≤ practicalChainProduct p j := by apply Nat.cast_le.mp ((log_le_log_iff (by exact_mod_cast (hprime j hj).pos) (by exact_mod_cast hjpos)).mp ((hhi j hj).trans hjsize)) refine ⟨j, hj, (hchain (j + 1) (by omega)).1, hbig, ?_, lt_of_le_of_lt hnew hsmall⟩ rw [practicalChainProduct_succ] have hprod := Nat.mul_le_mul_left (practicalChainProduct p j) hnew nlinarith end Erdos859Verification end /- Inlined development module: PracticalWindows.lean -/ section /- The geometric windows in the seed construction always contain primes. -/ open Real namespace Erdos859Verification theorem exists_prime_in_practical_window (j : ℕ) : ∃ p : ℕ, p.Prime ∧ 3 * ((3 : ℝ) / 2) ^ j < log (p : ℝ) ∧ log (p : ℝ) ≤ 4 * ((3 : ℝ) / 2) ^ j := by let r : ℝ := ((3 : ℝ) / 2) ^ j have hr : 1 ≤ r := one_le_pow₀ (by norm_num) have ha : 0 ≤ 3 * r := by positivity have hfloor : ⌊exp (3 * r)⌋₊ ≠ 0 := (Nat.floor_pos.mpr (one_le_exp_iff.mpr ha)).ne' obtain ⟨p, hp, hplo, hphi⟩ := Nat.exists_prime_lt_and_le_two_mul _ hfloor have hpR : (0 : ℝ) < p := by exact_mod_cast hp.pos have hlog2 : log (2 : ℝ) ≤ 1 := by have := log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) linarith refine ⟨p, hp, ?_, ?_⟩ · apply (lt_log_iff_exp_lt hpR).mpr exact (Nat.floor_lt (exp_pos _).le).mp hplo · apply (log_le_iff_le_exp hpR).mpr calc (p : ℝ) ≤ 2 * (⌊exp (3 * r)⌋₊ : ℝ) := by exact_mod_cast hphi _ ≤ 2 * exp (3 * r) := mul_le_mul_of_nonneg_left (Nat.floor_le (exp_pos _).le) (by norm_num) _ = exp (log 2 + 3 * r) := by rw [exp_add, exp_log (by norm_num)] _ ≤ exp (4 * r) := exp_le_exp.mpr (by linarith) theorem exists_practical_window_sequence : ∃ p : ℕ → ℕ, (∀ j, (p j).Prime) ∧ (∀ j, 3 * ((3 : ℝ) / 2) ^ j ≤ log (p j)) ∧ (∀ j, log (p j) ≤ 4 * ((3 : ℝ) / 2) ^ j) := by choose p hp hlo hhi using exists_prime_in_practical_window exact ⟨p, hp, fun j ↦ (hlo j).le, hhi⟩ end Erdos859Verification end /- Inlined development module: PrimeBandEvents.lean -/ section /- Finite probabilities of selecting at least one prime from a band. -/ open Finset Real namespace Erdos859Verification theorem primePatternWeight_empty (P : Finset ℕ) : primePatternWeight P ∅ = ∏ p ∈ P, (1 - 1 / (p : ℝ)) := by simp [primePatternWeight] theorem primePatternWeight_empty_le_exp {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) : primePatternWeight P ∅ ≤ exp (-(∑ p ∈ P, 1 / (p : ℝ))) := by rw [primePatternWeight_empty] calc _ ≤ ∏ p ∈ P, exp (-(1 / (p : ℝ))) := by apply Finset.prod_le_prod · intro p hp have hp1 : (1 : ℝ) ≤ p := by exact_mod_cast (hP p hp).one_le have hp0 : (0 : ℝ) < p := by exact_mod_cast (hP p hp).pos exact sub_nonneg.mpr ((div_le_one hp0).mpr hp1) · intro p _ have h := Real.add_one_le_exp (-(1 / (p : ℝ))) linarith _ = _ := by rw [← exp_sum, sum_neg_distrib] noncomputable def primeBandHitWeight (P : Finset ℕ) : ℝ := ∑ T ∈ P.powerset with T.Nonempty, primePatternWeight P T theorem primeBandHitWeight_eq (P : Finset ℕ) : primeBandHitWeight P = 1 - primePatternWeight P ∅ := by classical have hfilter : P.powerset.filter (fun T ↦ T.Nonempty) = P.powerset.erase ∅ := by ext T simp [Finset.nonempty_iff_ne_empty, and_comm] unfold primeBandHitWeight rw [hfilter] have h := sum_erase_add P.powerset (primePatternWeight P) (mem_powerset.mpr (empty_subset P)) rw [sum_primePatternWeight] at h linarith theorem primeBandHitWeight_lower {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {m : ℝ} (hmass : m ≤ ∑ p ∈ P, 1 / (p : ℝ)) : 1 - exp (-m) ≤ primeBandHitWeight P := by rw [primeBandHitWeight_eq] have h := primePatternWeight_empty_le_exp hP have hexp : exp (-(∑ p ∈ P, 1 / (p : ℝ))) ≤ exp (-m) := exp_le_exp.mpr (neg_le_neg hmass) linarith end Erdos859Verification end /- Inlined development module: PrimeCorrelation.lean -/ section /- Positive association of the original and tilted finite prime laws. -/ open Finset open scoped FinsetFamily namespace Erdos859Verification theorem primePatternWeight_modular (P S T : Finset ℕ) : primePatternWeight P S * primePatternWeight P T = primePatternWeight P (S ∩ T) * primePatternWeight P (S ∪ T) := by classical unfold primePatternWeight rw [← prod_mul_distrib, ← prod_mul_distrib] apply prod_congr rfl intro p _ by_cases hS : p ∈ S <;> by_cases hT : p ∈ T <;> simp [hS, hT, mul_comm] /-- The powerset form of FKG, stated directly for finite expectations. -/ theorem powerset_positive_association (P : Finset ℕ) (w f g : Finset ℕ → ℝ) (hw : ∀ T, 0 ≤ w T) (hf0 : ∀ T, 0 ≤ f T) (hg0 : ∀ T, 0 ≤ g T) (hf : Monotone f) (hg : Monotone g) (hmod : ∀ S T, w S * w T ≤ w (S ∩ T) * w (S ∪ T)) (hnorm : ∑ T ∈ P.powerset, w T = 1) : (∑ T ∈ P.powerset, w T * f T) * (∑ T ∈ P.powerset, w T * g T) ≤ ∑ T ∈ P.powerset, w T * (f T * g T) := by have h := P.four_functions_theorem (f₁ := fun T ↦ w T * f T) (f₂ := fun T ↦ w T * g T) (f₃ := w) (f₄ := fun T ↦ w T * (f T * g T)) (fun T ↦ mul_nonneg (hw T) (hf0 T)) (fun T ↦ mul_nonneg (hw T) (hg0 T)) hw (fun T ↦ mul_nonneg (hw T) (mul_nonneg (hf0 T) (hg0 T))) (fun {S} _ {T} _ ↦ show (w S * f S) * (w T * g T) ≤ w (S ∩ T) * (w (S ∪ T) * (f (S ∪ T) * g (S ∪ T))) from ?_) (𝒜 := P.powerset) (ℬ := P.powerset) subset_rfl subset_rfl · simpa only [powerset_infs_powerset_self, powerset_sups_powerset_self, hnorm, one_mul] using h · calc _ = (w S * w T) * (f S * g T) := by ring _ ≤ (w (S ∩ T) * w (S ∪ T)) * (f (S ∪ T) * g (S ∪ T)) := mul_le_mul (hmod S T) (mul_le_mul (hf subset_union_left) (hg subset_union_right) (hg0 T) (hf0 _)) (mul_nonneg (hf0 S) (hg0 T)) (mul_nonneg (hw _) (hw _)) _ = _ := by ring theorem prime_positive_association {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (f g : Finset ℕ → ℝ) (hf0 : ∀ T, 0 ≤ f T) (hg0 : ∀ T, 0 ≤ g T) (hf : Monotone f) (hg : Monotone g) : (∑ T ∈ P.powerset, primePatternWeight P T * f T) * (∑ T ∈ P.powerset, primePatternWeight P T * g T) ≤ ∑ T ∈ P.powerset, primePatternWeight P T * (f T * g T) := powerset_positive_association P (primePatternWeight P) f g (fun T ↦ (primePatternWeight_pos hP T).le) hf0 hg0 hf hg (fun S T ↦ (primePatternWeight_modular P S T).le) (sum_primePatternWeight P) theorem primeTiltWeight_modular (P S T : Finset ℕ) (lam : ℝ) : primeTiltWeight P lam S * primeTiltWeight P lam T = primeTiltWeight P lam (S ∩ T) * primeTiltWeight P lam (S ∪ T) := by unfold primeTiltWeight have hcard : S.card + T.card = (S ∩ T).card + (S ∪ T).card := by have := card_union_add_card_inter S T omega calc _ = (primePatternWeight P S * primePatternWeight P T) * lam ^ (S.card + T.card) / primeTiltNormalizer P lam ^ 2 := by rw [pow_add]; ring _ = (primePatternWeight P (S ∩ T) * primePatternWeight P (S ∪ T)) * lam ^ ((S ∩ T).card + (S ∪ T).card) / primeTiltNormalizer P lam ^ 2 := by rw [primePatternWeight_modular, hcard] _ = _ := by rw [pow_add]; ring theorem primeTilt_positive_association {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (f g : Finset ℕ → ℝ) (hf0 : ∀ T, 0 ≤ f T) (hg0 : ∀ T, 0 ≤ g T) (hf : Monotone f) (hg : Monotone g) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * f T) * (∑ T ∈ P.powerset, primeTiltWeight P lam T * g T) ≤ ∑ T ∈ P.powerset, primeTiltWeight P lam T * (f T * g T) := by apply powerset_positive_association P (primeTiltWeight P lam) f g _ hf0 hg0 hf hg (fun S T ↦ (primeTiltWeight_modular P S T lam).le) (sum_primeTiltWeight hP hlam) intro T exact div_nonneg (mul_nonneg (primePatternWeight_pos hP T).le (pow_nonneg hlam.le _)) (primeTiltNormalizer_pos hP hlam).le end Erdos859Verification end /- Inlined development module: PrimeProjection.lean -/ section /- Consistency of the finite prime laws under restriction to fewer primes. -/ open Finset Filter open scoped Topology namespace Erdos859Verification theorem prime_expectation_restrict {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) (F : Finset ℕ → ℝ) : (∑ T ∈ P.powerset, primePatternWeight P T * F (T ∩ B)) = ∑ U ∈ B.powerset, primePatternWeight B U * F U := by apply tendsto_nhds_unique (tendsto_mean_prime_observable hP (fun T ↦ F (T ∩ B))) convert tendsto_mean_prime_observable (fun p hp ↦ hP p (hB hp)) F using 1 funext N congr 1 apply sum_congr rfl intro n _ congr 1 ext p simp only [mem_inter, mem_filter] constructor · exact fun hp ↦ ⟨hp.2, hp.1.2⟩ · exact fun hp ↦ ⟨⟨hB hp.1, hp.2⟩, hp.1⟩ noncomputable def primeBandHitIndicator (B T : Finset ℕ) : ℝ := if (T ∩ B).Nonempty then 1 else 0 theorem primeBandHitIndicator_nonneg (B T : Finset ℕ) : 0 ≤ primeBandHitIndicator B T := by unfold primeBandHitIndicator split_ifs <;> norm_num theorem primeBandHitIndicator_monotone (B : Finset ℕ) : Monotone (primeBandHitIndicator B) := by intro S T hST unfold primeBandHitIndicator by_cases hS : (S ∩ B).Nonempty · have hT : (T ∩ B).Nonempty := hS.mono (inter_subset_inter hST subset_rfl) simp [hS, hT] · simp only [if_neg hS] split_ifs <;> norm_num theorem primeBandHitIndicator_expectation {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) : (∑ T ∈ P.powerset, primePatternWeight P T * primeBandHitIndicator B T) = primeBandHitWeight B := by unfold primeBandHitIndicator rw [prime_expectation_restrict hP hB (fun U ↦ if U.Nonempty then (1 : ℝ) else 0)] unfold primeBandHitWeight rw [sum_filter] apply sum_congr rfl intro U _ split_ifs <;> simp theorem primeBandHitWeight_pos {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hne : P.Nonempty) : 0 < primeBandHitWeight P := by unfold primeBandHitWeight apply sum_pos' · intro T _ exact (primePatternWeight_pos hP T).le · obtain ⟨p, hp⟩ := hne exact ⟨{p}, mem_filter.mpr ⟨mem_powerset.mpr (singleton_subset_iff.mpr hp), singleton_nonempty p⟩, primePatternWeight_pos hP {p}⟩ end Erdos859Verification end /- Inlined development module: PrimeJointEvents.lean -/ section /- Lower bounds for simultaneous increasing prime events. -/ open Finset namespace Erdos859Verification theorem powerset_positive_association_prod (P I : Finset ℕ) (w : Finset ℕ → ℝ) (F : ℕ → Finset ℕ → ℝ) (hw : ∀ T, 0 ≤ w T) (hF0 : ∀ i T, 0 ≤ F i T) (hF : ∀ i, Monotone (F i)) (hmod : ∀ S T, w S * w T ≤ w (S ∩ T) * w (S ∪ T)) (hnorm : ∑ T ∈ P.powerset, w T = 1) : (∏ i ∈ I, ∑ T ∈ P.powerset, w T * F i T) ≤ ∑ T ∈ P.powerset, w T * ∏ i ∈ I, F i T := by induction I using Finset.induction_on with | empty => simp [hnorm] | @insert i I hi ih => simp_rw [prod_insert hi] calc _ ≤ (∑ T ∈ P.powerset, w T * F i T) * (∑ T ∈ P.powerset, w T * ∏ j ∈ I, F j T) := mul_le_mul_of_nonneg_left ih (sum_nonneg (fun T _ ↦ mul_nonneg (hw T) (hF0 i T))) _ ≤ _ := by apply powerset_positive_association P w (F i) (fun T ↦ ∏ j ∈ I, F j T) hw (hF0 i) (fun T ↦ prod_nonneg (fun j _ ↦ hF0 j T)) (hF i) _ hmod hnorm intro S T hST exact prod_le_prod (fun j _ ↦ hF0 j S) (fun j _ ↦ hF j hST) /-- Hitting all the bands costs at most the product of the separate costs. The bands need not be disjoint for this lower bound. -/ theorem prime_joint_band_hit_lower {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (I : Finset ℕ) (B : ℕ → Finset ℕ) (hB : ∀ i ∈ I, B i ⊆ P) : (∏ i ∈ I, primeBandHitWeight (B i)) ≤ ∑ T ∈ P.powerset, primePatternWeight P T * (if ∀ i ∈ I, (T ∩ B i).Nonempty then (1 : ℝ) else 0) := by classical calc _ = ∏ i ∈ I, ∑ T ∈ P.powerset, primePatternWeight P T * primeBandHitIndicator (B i) T := by apply prod_congr rfl intro i hi exact (primeBandHitIndicator_expectation hP (hB i hi)).symm _ ≤ ∑ T ∈ P.powerset, primePatternWeight P T * ∏ i ∈ I, primeBandHitIndicator (B i) T := powerset_positive_association_prod P I (primePatternWeight P) (fun i ↦ primeBandHitIndicator (B i)) (fun T ↦ (primePatternWeight_pos hP T).le) (fun i ↦ primeBandHitIndicator_nonneg (B i)) (fun i ↦ primeBandHitIndicator_monotone (B i)) (fun S T ↦ (primePatternWeight_modular P S T).le) (sum_primePatternWeight P) _ = _ := by simp only [primeBandHitIndicator, prod_boole] theorem prime_joint_band_hit_lower_pow {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (I : Finset ℕ) (B : ℕ → Finset ℕ) (hB : ∀ i ∈ I, B i ⊆ P) {eta : ℝ} (heta : 0 ≤ eta) (hband : ∀ i ∈ I, eta ≤ primeBandHitWeight (B i)) : eta ^ I.card ≤ ∑ T ∈ P.powerset, primePatternWeight P T * (if ∀ i ∈ I, (T ∩ B i).Nonempty then (1 : ℝ) else 0) := by calc _ = ∏ _i ∈ I, eta := (prod_const eta).symm _ ≤ ∏ i ∈ I, primeBandHitWeight (B i) := prod_le_prod (fun _ _ ↦ heta) hband _ ≤ _ := prime_joint_band_hit_lower hP I B hB end Erdos859Verification end /- Inlined development module: PracticalSeedProbability.lean -/ section /- A uniform positive probability of hitting each practical-seed prime band. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification noncomputable def practicalPrimeBand (j : ℕ) : Finset ℕ := primeLogWindow (3 * ((3 : ℝ) / 2) ^ j) (4 * ((3 : ℝ) / 2) ^ j) theorem mem_practicalPrimeBand {j p : ℕ} : p ∈ practicalPrimeBand j ↔ p.Prime ∧ 3 * ((3 : ℝ) / 2) ^ j < log (p : ℝ) ∧ log (p : ℝ) ≤ 4 * ((3 : ℝ) / 2) ^ j := by simp only [practicalPrimeBand, primeLogWindow, mem_filter, mem_Ioc] constructor · rintro ⟨⟨hlo, hhi⟩, hp⟩ have hpR : (0 : ℝ) < p := by exact_mod_cast hp.pos exact ⟨hp, (lt_log_iff_exp_lt hpR).mpr ((Nat.floor_lt (exp_pos _).le).mp hlo), (log_le_iff_le_exp hpR).mpr ((Nat.le_floor_iff (exp_pos _).le).mp hhi)⟩ · rintro ⟨hp, hlo, hhi⟩ have hpR : (0 : ℝ) < p := by exact_mod_cast hp.pos exact ⟨⟨(Nat.floor_lt (exp_pos _).le).mpr ((lt_log_iff_exp_lt hpR).mp hlo), (Nat.le_floor_iff (exp_pos _).le).mpr ((log_le_iff_le_exp hpR).mp hhi)⟩, hp⟩ theorem practicalPrimeBand_prime (j : ℕ) : ∀ p ∈ practicalPrimeBand j, p.Prime := fun _ hp ↦ (mem_practicalPrimeBand.mp hp).1 theorem practicalPrimeBand_nonempty (j : ℕ) : (practicalPrimeBand j).Nonempty := by obtain ⟨p, hp, hlo, hhi⟩ := exists_prime_in_practical_window j exact ⟨p, mem_practicalPrimeBand.mpr ⟨hp, hlo, hhi⟩⟩ theorem tendsto_practicalPrimeBand_mass : Tendsto (fun j : ℕ ↦ ∑ p ∈ practicalPrimeBand j, 1 / (p : ℝ)) atTop (𝓝 (log ((4 : ℝ) / 3))) := by have hp : Tendsto (fun j : ℕ ↦ ((3 : ℝ) / 2) ^ j) atTop atTop := tendsto_pow_atTop_atTop_of_one_lt (by norm_num) have ha : Tendsto (fun j : ℕ ↦ 3 * ((3 : ℝ) / 2) ^ j) atTop atTop := hp.const_mul_atTop (by norm_num) have he : Tendsto (fun j : ℕ ↦ 2 * mertensErrorConstant / (3 * ((3 : ℝ) / 2) ^ j)) atTop (𝓝 0) := tendsto_const_nhds.div_atTop ha apply tendsto_sub_nhds_zero_iff.mp apply squeeze_zero_norm' _ he apply Filter.Eventually.of_forall intro j have hpow : 1 ≤ ((3 : ℝ) / 2) ^ j := one_le_pow₀ (by norm_num) have hlog2 : log (2 : ℝ) ≤ 1 := by have := log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) linarith have h := primeLogWindowMass_estimate (show log 2 ≤ 3 * ((3 : ℝ) / 2) ^ j by linarith) (show 3 * ((3 : ℝ) / 2) ^ j ≤ 4 * ((3 : ℝ) / 2) ^ j by linarith) have hr : 4 * ((3 : ℝ) / 2) ^ j / (3 * ((3 : ℝ) / 2) ^ j) = (4 : ℝ) / 3 := by field_simp rw [hr] at h simpa only [Real.norm_eq_abs, practicalPrimeBand, primeLogWindow, primeLogWindowMass] using h theorem exists_uniform_pos_lower {f : ℕ → ℝ} {c : ℝ} (hpos : ∀ n, 0 < f n) (hc : 0 < c) (hevent : ∀ᶠ n in atTop, c ≤ f n) : ∃ eta > 0, eta ≤ c ∧ ∀ n, eta ≤ f n := by have hfinite (N : ℕ) : ∃ eta > 0, eta ≤ c ∧ ∀ j < N, eta ≤ f j := by induction N with | zero => exact ⟨c, hc, le_rfl, by omega⟩ | succ N ih => obtain ⟨eta, heta, hetac, hprev⟩ := ih refine ⟨min eta (f N), lt_min heta (hpos N), (min_le_left _ _).trans hetac, ?_⟩ intro j hj by_cases hjN : j = N · subst j exact min_le_right _ _ · exact (min_le_left _ _).trans (hprev j (by omega)) obtain ⟨N, hN⟩ := Filter.eventually_atTop.mp hevent obtain ⟨eta, heta, hetac, hsmall⟩ := hfinite N refine ⟨eta, heta, hetac, fun n ↦ ?_⟩ by_cases hn : n < N · exact hsmall n hn · exact hetac.trans (hN n (by omega)) /-- All the seed windows have a single common positive hit-probability lower bound. The finitely many early windows are covered by Bertrand. -/ theorem exists_uniform_practicalPrimeBand_hit : ∃ eta : ℝ, 0 < eta ∧ eta < 1 ∧ ∀ j : ℕ, eta ≤ primeBandHitWeight (practicalPrimeBand j) := by have hlog : 0 < log ((4 : ℝ) / 3) := log_pos (by norm_num) let c : ℝ := 1 - exp (-(log ((4 : ℝ) / 3) / 2)) have hc : 0 < c := by apply sub_pos.mpr exact exp_lt_one_iff.mpr (by linarith) have hc1 : c < 1 := by have := exp_pos (-(log ((4 : ℝ) / 3) / 2)) dsimp [c] linarith have hevent : ∀ᶠ j in atTop, c ≤ primeBandHitWeight (practicalPrimeBand j) := by filter_upwards [tendsto_practicalPrimeBand_mass.eventually_const_lt (show log ((4 : ℝ) / 3) / 2 < log ((4 : ℝ) / 3) by linarith)] with j hj exact primeBandHitWeight_lower (practicalPrimeBand_prime j) hj.le obtain ⟨eta, heta, hetac, hbound⟩ := exists_uniform_pos_lower (fun j ↦ primeBandHitWeight_pos (practicalPrimeBand_prime j) (practicalPrimeBand_nonempty j)) hc hevent exact ⟨eta, heta, hetac.trans_lt hc1, hbound⟩ end Erdos859Verification end /- Inlined development module: PracticalSeedEvents.lean -/ section /- The finite event selecting the seed primes and hitting each later window. -/ open Finset Real namespace Erdos859Verification theorem primeBandHitWeight_singleton (p : ℕ) : primeBandHitWeight {p} = 1 / (p : ℝ) := by classical have hs : ({p} : Finset ℕ).powerset.filter (fun T ↦ T.Nonempty) = {{p}} := by ext T simp only [mem_filter, mem_powerset, mem_singleton] constructor · exact fun h ↦ h.2.subset_singleton_iff.mp h.1 · intro h subst T simp rw [primeBandHitWeight, hs] simp [primePatternWeight] noncomputable def practicalSeedBand : ℕ → Finset ℕ | 0 => {2} | 1 => {3} | 2 => {5} | 3 => {7} | j + 4 => practicalPrimeBand j theorem practicalSeedBand_prime (j : ℕ) : ∀ p ∈ practicalSeedBand j, p.Prime := by rcases lt_or_ge j 4 with hj | hj · interval_cases j <;> norm_num [practicalSeedBand] · obtain ⟨k, rfl⟩ := Nat.exists_eq_add_of_le hj rw [Nat.add_comm 4 k] exact practicalPrimeBand_prime k theorem exists_uniform_practicalSeedBand_hit : ∃ eta : ℝ, 0 < eta ∧ eta < 1 ∧ ∀ j : ℕ, eta ≤ primeBandHitWeight (practicalSeedBand j) := by obtain ⟨eta, heta, heta1, hband⟩ := exists_uniform_practicalPrimeBand_hit refine ⟨min eta (1 / 7), lt_min heta (by norm_num), (min_le_left _ _).trans_lt heta1, ?_⟩ intro j rcases lt_or_ge j 4 with hj | hj · have hsmall : min eta ((1 : ℝ) / 7) ≤ 1 / 7 := min_le_right _ _ interval_cases j <;> simp only [practicalSeedBand, primeBandHitWeight_singleton, Nat.cast_ofNat] <;> linarith · obtain ⟨k, rfl⟩ := Nat.exists_eq_add_of_le hj rw [Nat.add_comm 4 k] exact (min_le_left _ _).trans (hband k) noncomputable def practicalSeedPrimeUniverse (N : ℕ) : Finset ℕ := (range (N + 4)).biUnion practicalSeedBand theorem practicalSeedPrimeUniverse_prime (N : ℕ) : ∀ p ∈ practicalSeedPrimeUniverse N, p.Prime := by intro p hp obtain ⟨j, _hj, hp⟩ := mem_biUnion.mp hp exact practicalSeedBand_prime j p hp theorem practicalSeedBand_subset {N j : ℕ} (hj : j < N + 4) : practicalSeedBand j ⊆ practicalSeedPrimeUniverse N := by intro p hp exact mem_biUnion.mpr ⟨j, mem_range.mpr hj, hp⟩ abbrev PracticalSeedPattern (N : ℕ) (T : Finset ℕ) : Prop := ∀ j < N + 4, (T ∩ practicalSeedBand j).Nonempty /-- The cost of the entire finite seed event is at most exponential in the number of geometric windows, with a fixed universal base. -/ theorem exists_practicalSeedPattern_weight_lower : ∃ eta : ℝ, 0 < eta ∧ eta < 1 ∧ ∀ N : ℕ, eta ^ (N + 4) ≤ ∑ T ∈ (practicalSeedPrimeUniverse N).powerset, primePatternWeight (practicalSeedPrimeUniverse N) T * (if PracticalSeedPattern N T then (1 : ℝ) else 0) := by classical obtain ⟨eta, heta, heta1, hband⟩ := exists_uniform_practicalSeedBand_hit refine ⟨eta, heta, heta1, fun N ↦ ?_⟩ have h := prime_joint_band_hit_lower_pow (practicalSeedPrimeUniverse_prime N) (range (N + 4)) practicalSeedBand (fun j hj ↦ practicalSeedBand_subset (mem_range.mp hj)) heta.le (fun j _ ↦ hband j) simpa only [card_range, mem_range, PracticalSeedPattern] using h theorem PracticalSeedPattern.seed_primes {N : ℕ} {T : Finset ℕ} (h : PracticalSeedPattern N T) : ({2, 3, 5, 7} : Finset ℕ) ⊆ T := by have hsingle {p : ℕ} (hp : (T ∩ {p}).Nonempty) : p ∈ T := by obtain ⟨q, hq⟩ := hp obtain ⟨hqT, hqp⟩ := mem_inter.mp hq simpa only [mem_singleton.mp hqp] using hqT have h2 : 2 ∈ T := hsingle (h 0 (by omega)) have h3 : 3 ∈ T := hsingle (h 1 (by omega)) have h5 : 5 ∈ T := hsingle (h 2 (by omega)) have h7 : 7 ∈ T := hsingle (h 3 (by omega)) simpa only [insert_subset_iff, singleton_subset_iff] using And.intro h2 ⟨h3, h5, h7⟩ theorem PracticalSeedPattern.prime_windows {N : ℕ} {T : Finset ℕ} (h : PracticalSeedPattern N T) (j : ℕ) (hj : j < N) : (T ∩ practicalPrimeBand j).Nonempty := by exact h (j + 4) (by omega) end Erdos859Verification end /- Inlined development module: PracticalSeedSupport.lean -/ section /- A successful finite seed event provides a large practical divisor. -/ open Finset Real namespace Erdos859Verification theorem practicalChainProduct_coprime_next {p : ℕ → ℕ} {N j : ℕ} (hprime : ∀ i < N, (p i).Prime) (hlo : ∀ i < N, 3 * ((3 : ℝ) / 2) ^ i ≤ log (p i)) (hhi : ∀ i < N, log (p i) ≤ 4 * ((3 : ℝ) / 2) ^ i) (hj : j < N) : Nat.Coprime (practicalChainProduct p j) (p j) := by have h7 : 7 < p j := by have hpow : (1 : ℝ) ≤ ((3 : ℝ) / 2) ^ j := one_le_pow₀ (by norm_num) have hlog : log (7 : ℝ) < log (p j) := by have := hlo j hj linarith [log_seven_lt_three] exact Nat.cast_lt.mp ((log_lt_log_iff (by norm_num) (by exact_mod_cast (hprime j hj).pos)).mp hlog) apply Nat.Coprime.mul_left (coprime_210_of_prime_gt_seven (hprime j hj) h7) apply Nat.Coprime.prod_left intro i hi exact (Nat.coprime_primes (hprime i ((mem_range.mp hi).trans hj)) (hprime j hj)).mpr (prime_window_strictMono hprime hlo hhi (mem_range.mp hi) hj).ne theorem practicalChainProduct_dvd {p : ℕ → ℕ} {N n : ℕ} (hprime : ∀ i < N, (p i).Prime) (hlo : ∀ i < N, 3 * ((3 : ℝ) / 2) ^ i ≤ log (p i)) (hhi : ∀ i < N, log (p i) ≤ 4 * ((3 : ℝ) / 2) ^ i) (hseed : 210 ∣ n) (hpdiv : ∀ i < N, p i ∣ n) : ∀ j ≤ N, practicalChainProduct p j ∣ n := by intro j induction j with | zero => simpa [practicalChainProduct] using fun _ : 0 ≤ N ↦ hseed | succ j ih => intro hj rw [practicalChainProduct_succ] exact (practicalChainProduct_coprime_next hprime hlo hhi (by omega)).mul_dvd_of_dvd_of_dvd (ih (by omega)) (hpdiv j (by omega)) def HasPracticalSeed (Z n : ℕ) : Prop := ∃ b : ℕ, Nat.IsPractical b ∧ Z ≤ b ∧ b < Z ^ 2 ∧ b ∣ n noncomputable def practicalSeedIndicator (Z : ℕ) (T : Finset ℕ) : ℝ := {U : Finset ℕ | HasPracticalSeed Z (∏ p ∈ U, p)}.indicator (fun _ ↦ (1 : ℝ)) T /-- Select one prime from each hit band and stop the practical chain as soon as it crosses `Z`. Its entire product divides the sampled prime product. -/ theorem PracticalSeedPattern.hasPracticalSeed {N Z : ℕ} {T : Finset ℕ} (h : PracticalSeedPattern N T) (hZ : 210 < Z) (hlarge : log (Z : ℝ) ≤ 4 * ((3 : ℝ) / 2) ^ N) : HasPracticalSeed Z (∏ p ∈ T, p) := by classical have hex : ∀ j : ℕ, ∃ p : ℕ, N ≤ j ∨ (p ∈ T ∧ p ∈ practicalPrimeBand j) := by intro j by_cases hj : j < N · obtain ⟨p, hp⟩ := h.prime_windows j hj exact ⟨p, Or.inr (mem_inter.mp hp)⟩ · exact ⟨2, Or.inl (Nat.le_of_not_gt hj)⟩ choose p hp0 using hex have hp : ∀ j < N, p j ∈ T ∧ p j ∈ practicalPrimeBand j := fun j hj ↦ (hp0 j).resolve_left (not_le_of_gt hj) have hprime : ∀ j < N, (p j).Prime := fun j hj ↦ (mem_practicalPrimeBand.mp (hp j hj).2).1 have hlo : ∀ j < N, 3 * ((3 : ℝ) / 2) ^ j ≤ log (p j) := fun j hj ↦ (mem_practicalPrimeBand.mp (hp j hj).2).2.1.le have hhi : ∀ j < N, log (p j) ≤ 4 * ((3 : ℝ) / 2) ^ j := fun j hj ↦ (mem_practicalPrimeBand.mp (hp j hj).2).2.2 have hseed : 210 ∣ ∏ p ∈ T, p := by have hd := Finset.prod_dvd_prod_of_subset ({2, 3, 5, 7} : Finset ℕ) T (fun q ↦ q) h.seed_primes norm_num at hd exact hd have hpdiv : ∀ j < N, p j ∣ ∏ q ∈ T, q := fun j hj ↦ Finset.dvd_prod_of_mem (fun q ↦ q) (hp j hj).1 obtain ⟨j, hj, hpractical, hlow, hhigh, _⟩ := exists_practicalSeed_from_windows hprime hlo hhi hZ hlarge exact ⟨practicalChainProduct p (j + 1), hpractical, hlow, hhigh, practicalChainProduct_dvd hprime hlo hhi hseed hpdiv (j + 1) (by omega)⟩ /-- A quantitative, unconditional finite probability lower bound for a practical seed, with the geometric horizon specified explicitly. -/ theorem exists_practicalSeed_weight_lower : ∃ eta : ℝ, 0 < eta ∧ eta < 1 ∧ ∀ N Z : ℕ, 210 < Z → log (Z : ℝ) ≤ 4 * ((3 : ℝ) / 2) ^ N → eta ^ (N + 4) ≤ ∑ T ∈ (practicalSeedPrimeUniverse N).powerset, primePatternWeight (practicalSeedPrimeUniverse N) T * practicalSeedIndicator Z T := by classical obtain ⟨eta, heta, heta1, hbound⟩ := exists_practicalSeedPattern_weight_lower refine ⟨eta, heta, heta1, fun N Z hZ hlarge ↦ (hbound N).trans ?_⟩ apply sum_le_sum intro T _ simp only [practicalSeedIndicator, Set.indicator_apply, Set.mem_ofPred_eq] by_cases hpat : PracticalSeedPattern N T · rw [if_pos hpat, if_pos (hpat.hasPracticalSeed hZ hlarge)] · simp only [if_neg hpat, mul_zero] have hw : 0 ≤ primePatternWeight (practicalSeedPrimeUniverse N) T := (primePatternWeight_pos (practicalSeedPrimeUniverse_prime N) T).le split_ifs <;> simp_all end Erdos859Verification end /- Inlined development module: PracticalSeedHorizon.lean -/ section /- A logarithmic number of geometric windows suffices for a practical seed. -/ open Finset Real namespace Erdos859Verification noncomputable def seedWindowCount (Z : ℕ) : ℕ := ⌈log (log (Z : ℝ) / 4) / log ((3 : ℝ) / 2)⌉₊ theorem four_lt_log_of_gt_210 {Z : ℕ} (hZ : 210 < Z) : 4 < log (Z : ℝ) := by exact four_le_log_210.trans_lt (log_lt_log (by norm_num) (by exact_mod_cast hZ)) theorem seedWindowCount_large {Z : ℕ} (hZ : 210 < Z) : log (Z : ℝ) ≤ 4 * ((3 : ℝ) / 2) ^ seedWindowCount Z := by have hlog := four_lt_log_of_gt_210 hZ have hr : 0 < log ((3 : ℝ) / 2) := log_pos (by norm_num) have hceil := Nat.le_ceil (log (log (Z : ℝ) / 4) / log ((3 : ℝ) / 2)) change log (log (Z : ℝ) / 4) / log ((3 : ℝ) / 2) ≤ (seedWindowCount Z : ℝ) at hceil have h := (div_le_iff₀ hr).mp hceil rw [← log_pow] at h have hle := (log_le_log_iff (by positivity : 0 < log (Z : ℝ) / 4) (pow_pos (by norm_num : (0 : ℝ) < 3 / 2) _)).mp h linarith theorem seedWindowCount_upper {Z : ℕ} (hZ : 210 < Z) : (seedWindowCount Z : ℝ) < log (log (Z : ℝ)) / log ((3 : ℝ) / 2) + 1 := by have hlog := four_lt_log_of_gt_210 hZ have hr : 0 < log ((3 : ℝ) / 2) := log_pos (by norm_num) have hquot : 1 ≤ log (Z : ℝ) / 4 := by linarith have hx : 0 ≤ log (log (Z : ℝ) / 4) / log ((3 : ℝ) / 2) := div_nonneg (log_nonneg hquot) hr.le have hlogdiv : log (log (Z : ℝ) / 4) ≤ log (log (Z : ℝ)) := by rw [log_div (by linarith : log (Z : ℝ) ≠ 0) (by norm_num)] exact sub_le_self _ (log_nonneg (by norm_num)) exact (Nat.ceil_lt_add_one hx).trans_le (add_le_add (div_le_div_of_nonneg_right hlogdiv hr.le) le_rfl) theorem seedWindowCount_previous {Z j : ℕ} (hZ : 210 < Z) (hj : j < seedWindowCount Z) : 4 * ((3 : ℝ) / 2) ^ j < log (Z : ℝ) := by have hlog := four_lt_log_of_gt_210 hZ have hr : 0 < log ((3 : ℝ) / 2) := log_pos (by norm_num) have hjR : (j : ℝ) < log (log (Z : ℝ) / 4) / log ((3 : ℝ) / 2) := Nat.lt_ceil.mp hj have h := (lt_div_iff₀ hr).mp hjR rw [← log_pow] at h have hlt := (log_lt_log_iff (pow_pos (by norm_num : (0 : ℝ) < 3 / 2) _) (by positivity : 0 < log (Z : ℝ) / 4)).mp h linarith /-- Every prime inspected by the seed event is smaller than its target scale. -/ theorem practicalSeedPrimeUniverse_lt {Z p : ℕ} (hZ : 210 < Z) (hp : p ∈ practicalSeedPrimeUniverse (seedWindowCount Z)) : p < Z := by obtain ⟨j, hj, hpj⟩ := mem_biUnion.mp hp have hjN := mem_range.mp hj rcases lt_or_ge j 4 with hj4 | hj4 · interval_cases j <;> simp only [practicalSeedBand, mem_singleton] at hpj <;> omega · obtain ⟨k, rfl⟩ := Nat.exists_eq_add_of_le hj4 rw [Nat.add_comm 4 k] at hpj have hpband := mem_practicalPrimeBand.mp hpj have hplog : log (p : ℝ) < log (Z : ℝ) := hpband.2.2.trans_lt (seedWindowCount_previous hZ (by omega)) exact Nat.cast_lt.mp ((log_lt_log_iff (by exact_mod_cast hpband.1.pos) (by exact_mod_cast (show 0 < Z by omega))).mp hplog) theorem seedWindowCount_probability_lower {eta : ℝ} (heta : 0 < eta) (heta1 : eta < 1) {Z : ℕ} (hZ : 210 < Z) : eta ^ 5 / (log (Z : ℝ)) ^ (-log eta / log ((3 : ℝ) / 2)) ≤ eta ^ (seedWindowCount Z + 4) := by have hlog : 0 < log (Z : ℝ) := by linarith [four_lt_log_of_gt_210 hZ] have hden := rpow_pos_of_pos hlog (-log eta / log ((3 : ℝ) / 2)) apply (log_le_log_iff (div_pos (pow_pos heta 5) hden) (pow_pos heta (seedWindowCount Z + 4))).mp rw [log_div (pow_pos heta 5).ne' hden.ne', log_pow, log_rpow hlog, log_pow] simp only [Nat.cast_add, Nat.cast_ofNat] have hmul := mul_le_mul_of_nonpos_right (seedWindowCount_upper hZ).le (log_neg heta heta1).le calc 5 * log eta - (-log eta / log (3 / 2)) * log (log (Z : ℝ)) = (log (log (Z : ℝ)) / log (3 / 2) + 1) * log eta + 4 * log eta := by ring _ ≤ ((seedWindowCount Z : ℝ) + 4) * log eta := by linarith /-- The seed probability loses only a fixed power of the logarithm, without requiring an asymptotic counting theorem for practical numbers. -/ theorem exists_practicalSeed_polylog_lower : ∃ c : ℝ, 0 < c ∧ ∃ C : ℝ, 0 < C ∧ ∀ Z : ℕ, 210 < Z → c / (log (Z : ℝ)) ^ C ≤ ∑ T ∈ (practicalSeedPrimeUniverse (seedWindowCount Z)).powerset, primePatternWeight (practicalSeedPrimeUniverse (seedWindowCount Z)) T * practicalSeedIndicator Z T := by obtain ⟨eta, heta, heta1, hbound⟩ := exists_practicalSeed_weight_lower refine ⟨eta ^ 5, pow_pos heta 5, -log eta / log ((3 : ℝ) / 2), div_pos (neg_pos.mpr (log_neg heta heta1)) (log_pos (by norm_num)), ?_⟩ intro Z hZ exact (seedWindowCount_probability_lower heta heta1 hZ).trans (hbound (seedWindowCount Z) Z hZ (seedWindowCount_large hZ)) end Erdos859Verification end /- Inlined development module: PrimeTiltMonotonicity.lean -/ section /- Increasing observables are improved by adding primes or tilting toward selection. -/ open Finset namespace Erdos859Verification theorem prime_expectation_mono_universe {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) (f : Finset ℕ → ℝ) (hf : Monotone f) : (∑ T ∈ B.powerset, primePatternWeight B T * f T) ≤ ∑ T ∈ P.powerset, primePatternWeight P T * f T := by rw [← prime_expectation_restrict hP hB f] apply sum_le_sum intro T _ exact mul_le_mul_of_nonneg_left (hf inter_subset_left) (primePatternWeight_pos hP T).le /-- FKG applied to the likelihood ratio gives stochastic domination by the tilted law whenever the tilt parameter is at least one. -/ theorem primeTilt_expectation_ge {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 1 ≤ lam) (f : Finset ℕ → ℝ) (hf0 : ∀ T, 0 ≤ f T) (hf : Monotone f) : (∑ T ∈ P.powerset, primePatternWeight P T * f T) ≤ ∑ T ∈ P.powerset, primeTiltWeight P lam T * f T := by have hlam0 : 0 < lam := zero_lt_one.trans_le hlam have hg : Monotone (fun T : Finset ℕ ↦ lam ^ T.card) := by intro S T hST exact pow_le_pow_right₀ hlam (card_le_card hST) have h := prime_positive_association hP f (fun T ↦ lam ^ T.card) hf0 (fun T ↦ (pow_pos hlam0 T.card).le) hf hg rw [primePatternWeight_moment] at h have hrewrite : (∑ T ∈ P.powerset, primeTiltWeight P lam T * f T) = (∑ T ∈ P.powerset, primePatternWeight P T * (f T * lam ^ T.card)) / primeTiltNormalizer P lam := by rw [sum_div] apply sum_congr rfl intro T _ unfold primeTiltWeight ring rw [hrewrite] exact (le_div_iff₀ (primeTiltNormalizer_pos hP hlam0)).mpr h end Erdos859Verification end /- Inlined development module: PracticalSeedTilted.lean -/ section /- The practical seed bound holds in every larger tilted prime model. -/ open Finset Real namespace Erdos859Verification theorem HasPracticalSeed.of_dvd {Z m n : ℕ} (h : HasPracticalSeed Z m) (hmn : m ∣ n) : HasPracticalSeed Z n := by obtain ⟨b, hb, hlo, hhi, hd⟩ := h exact ⟨b, hb, hlo, hhi, hd.trans hmn⟩ theorem practicalSeedIndicator_nonneg (Z : ℕ) (T : Finset ℕ) : 0 ≤ practicalSeedIndicator Z T := by classical simp only [practicalSeedIndicator, Set.indicator_apply, Set.mem_ofPred_eq] split_ifs <;> norm_num theorem practicalSeedIndicator_le_one (Z : ℕ) (T : Finset ℕ) : practicalSeedIndicator Z T ≤ 1 := by classical simp only [practicalSeedIndicator, Set.indicator_apply, Set.mem_ofPred_eq] split_ifs <;> norm_num theorem practicalSeedIndicator_monotone (Z : ℕ) : Monotone (practicalSeedIndicator Z) := by classical intro S T hST simp only [practicalSeedIndicator, Set.indicator_apply, Set.mem_ofPred_eq] by_cases hS : HasPracticalSeed Z (∏ p ∈ S, p) · have hT := hS.of_dvd (Finset.prod_dvd_prod_of_subset S T (fun p ↦ p) hST) rw [if_pos hS, if_pos hT] · rw [if_neg hS] split_ifs <;> norm_num /-- The same two constants work for all target scales, all larger finite prime universes, and every tilt parameter at least one. -/ theorem exists_practicalSeed_tilted_polylog_lower : ∃ c : ℝ, 0 < c ∧ ∃ C : ℝ, 0 < C ∧ ∀ Z : ℕ, 210 < Z → ∀ P : Finset ℕ, (∀ p ∈ P, p.Prime) → practicalSeedPrimeUniverse (seedWindowCount Z) ⊆ P → ∀ lam : ℝ, 1 ≤ lam → c / (log (Z : ℝ)) ^ C ≤ ∑ T ∈ P.powerset, primeTiltWeight P lam T * practicalSeedIndicator Z T := by obtain ⟨c, hc, C, hC, hseed⟩ := exists_practicalSeed_polylog_lower refine ⟨c, hc, C, hC, ?_⟩ intro Z hZ P hP hB lam hlam exact (hseed Z hZ).trans ((prime_expectation_mono_universe hP hB (practicalSeedIndicator Z) (practicalSeedIndicator_monotone Z)).trans (primeTilt_expectation_ge hP hlam (practicalSeedIndicator Z) (practicalSeedIndicator_nonneg Z) (practicalSeedIndicator_monotone Z))) end Erdos859Verification end /- Inlined development module: PracticalSeedAsymptotics.lean -/ section /- The practical seed event has zero cost on the exponential scale. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification theorem tendsto_neg_log_div_of_polylog_lower {Z : ℕ → ℕ} {p : ℕ → ℝ} {c C : ℝ} (hc : 0 < c) (hZ : ∀ᶠ n in atTop, 210 < Z n) (hlower : ∀ᶠ n in atTop, c / (log (Z n : ℝ)) ^ C ≤ p n) (hupper : ∀ᶠ n in atTop, p n ≤ 1) (hscale : Tendsto (fun n : ℕ ↦ log (log (Z n : ℝ)) / n) atTop (𝓝 0)) : Tendsto (fun n : ℕ ↦ -log (p n) / n) atTop (𝓝 0) := by have hlim : Tendsto (fun n : ℕ ↦ -log c / n + C * (log (log (Z n : ℝ)) / n)) atTop (𝓝 0) := by simpa using (tendsto_const_div_atTop_nhds_zero_nat (-log c)).add (hscale.const_mul C) have hbound : ∀ᶠ n in atTop, 0 ≤ -log (p n) / n ∧ -log (p n) / n ≤ -log c / n + C * (log (log (Z n : ℝ)) / n) := by filter_upwards [hZ, hlower, hupper, eventually_gt_atTop 0] with n hnZ hlo hhi hn have hnR : (0 : ℝ) < n := by exact_mod_cast hn have hlog : 0 < log (Z n : ℝ) := by linarith [four_lt_log_of_gt_210 hnZ] have hden := rpow_pos_of_pos hlog C have hlowpos := div_pos hc hden have hp : 0 < p n := hlowpos.trans_le hlo have hloglow := (log_le_log_iff hlowpos hp).mpr hlo rw [log_div hc.ne' hden.ne', log_rpow hlog] at hloglow refine ⟨div_nonneg (neg_nonneg.mpr (log_nonpos hp.le hhi)) hnR.le, ?_⟩ have hd := div_le_div_of_nonneg_right (neg_le_neg hloglow) hnR.le calc _ ≤ -(log c - C * log (log (Z n : ℝ))) / n := hd _ = -log c / n + C * (log (log (Z n : ℝ)) / n) := by ring exact squeeze_zero' (hbound.mono fun _ h ↦ h.1) (hbound.mono fun _ h ↦ h.2) hlim noncomputable def practicalSeedTiltProbability (Z : ℕ) (P : Finset ℕ) (lam : ℝ) : ℝ := ∑ T ∈ P.powerset, primeTiltWeight P lam T * practicalSeedIndicator Z T theorem practicalSeedTiltProbability_le_one {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (Z : ℕ) : practicalSeedTiltProbability Z P lam ≤ 1 := by calc _ ≤ ∑ T ∈ P.powerset, primeTiltWeight P lam T := by apply sum_le_sum intro T _ apply mul_le_of_le_one_right · exact div_nonneg (mul_nonneg (primePatternWeight_pos hP T).le (pow_pos hlam _).le) (primeTiltNormalizer_pos hP hlam).le · exact practicalSeedIndicator_le_one Z T _ = 1 := sum_primeTiltWeight hP hlam /-- The only scale condition needed from a later construction is `log(log Z_n) = o(n)`. The seed probability then has zero exponential cost. -/ theorem tendsto_neg_log_practicalSeedTiltProbability_div (Z : ℕ → ℕ) (P : ℕ → Finset ℕ) (hP : ∀ n p, p ∈ P n → p.Prime) {lam : ℝ} (hlam : 1 ≤ lam) (hZ : ∀ᶠ n in atTop, 210 < Z n) (hB : ∀ᶠ n in atTop, practicalSeedPrimeUniverse (seedWindowCount (Z n)) ⊆ P n) (hscale : Tendsto (fun n : ℕ ↦ log (log (Z n : ℝ)) / n) atTop (𝓝 0)) : Tendsto (fun n : ℕ ↦ -log (practicalSeedTiltProbability (Z n) (P n) lam) / n) atTop (𝓝 0) := by obtain ⟨c, hc, C, _hC, hseed⟩ := exists_practicalSeed_tilted_polylog_lower apply tendsto_neg_log_div_of_polylog_lower (C := C) hc hZ _ _ hscale · filter_upwards [hZ, hB] with n hnZ hnB exact hseed (Z n) hnZ (P n) (hP n) hnB lam hlam · exact Filter.Eventually.of_forall fun n ↦ practicalSeedTiltProbability_le_one (hP n) (zero_lt_one.trans_le hlam) (Z n) end Erdos859Verification end /- Inlined development module: PracticalSeedScale.lean -/ section /- The explicit seed scale used by the proposed divisor construction. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification theorem log_ceil_exp_bounds {s : ℝ} (hs : 0 ≤ s) : s ≤ log (⌈exp s⌉₊ : ℝ) ∧ log (⌈exp s⌉₊ : ℝ) ≤ s + log 2 := by have he := Nat.le_ceil (exp s) have hz : (0 : ℝ) < ⌈exp s⌉₊ := (exp_pos s).trans_le he refine ⟨(le_log_iff_exp_le hz).mpr he, ?_⟩ have hexp : 1 ≤ exp s := one_le_exp hs have hc := Nat.ceil_lt_add_one (exp_pos s).le have hle : (⌈exp s⌉₊ : ℝ) ≤ 2 * exp s := by linarith have h := (log_le_log_iff hz (mul_pos (by norm_num) (exp_pos s))).mpr hle rw [log_mul (by norm_num : (2 : ℝ) ≠ 0) (exp_ne_zero s), log_exp] at h linarith noncomputable def seedScale (k : ℕ) : ℕ := ⌈exp (2 * (k : ℝ) ^ 3)⌉₊ theorem eventually_seedScale_gt : ∀ᶠ k in atTop, 210 < seedScale k := by filter_upwards [eventually_gt_atTop 210] with k hk have hkR : (210 : ℝ) < k := by exact_mod_cast hk have hpow : (k : ℝ) ≤ (k : ℝ) ^ 3 := le_self_pow₀ (by linarith) (by norm_num) have he := add_one_le_exp (2 * (k : ℝ) ^ 3) have hc := Nat.le_ceil (exp (2 * (k : ℝ) ^ 3)) have hlt : (210 : ℝ) < (seedScale k : ℝ) := by dsimp [seedScale] linarith exact_mod_cast hlt theorem tendsto_log_log_seedScale_div : Tendsto (fun k : ℕ ↦ log (log (seedScale k : ℝ)) / k) atTop (𝓝 0) := by have hloglim : Tendsto (fun k : ℕ ↦ log (k : ℝ) / k) atTop (𝓝 0) := by have hnat : Tendsto (fun k : ℕ ↦ (k : ℝ)) atTop atTop := tendsto_natCast_atTop_atTop simpa only [Function.comp_def, pow_one, one_mul, add_zero] using (tendsto_pow_log_div_mul_add_atTop 1 0 1 one_ne_zero).comp hnat have hlim : Tendsto (fun k : ℕ ↦ log 3 / k + 3 * (log (k : ℝ) / k)) atTop (𝓝 0) := by simpa using (tendsto_const_div_atTop_nhds_zero_nat (log 3)).add (hloglim.const_mul 3) have hbound : ∀ᶠ k : ℕ in atTop, 0 ≤ log (log (seedScale k : ℝ)) / k ∧ log (log (seedScale k : ℝ)) / k ≤ log 3 / k + 3 * (log (k : ℝ) / k) := by filter_upwards [eventually_gt_atTop 0] with k hk have hkR : (0 : ℝ) < k := by exact_mod_cast hk have hk1 : (1 : ℝ) ≤ k := by exact_mod_cast hk have hpow : (1 : ℝ) ≤ (k : ℝ) ^ 3 := one_le_pow₀ hk1 have hlog := log_ceil_exp_bounds (show 0 ≤ 2 * (k : ℝ) ^ 3 by positivity) change 2 * (k : ℝ) ^ 3 ≤ log (seedScale k : ℝ) ∧ log (seedScale k : ℝ) ≤ 2 * (k : ℝ) ^ 3 + log 2 at hlog have hlogpos : 0 < log (seedScale k : ℝ) := by linarith [hlog.1] have hlo : 1 ≤ log (seedScale k : ℝ) := by linarith [hlog.1] have hlog2 : log (2 : ℝ) ≤ 1 := by have h := log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) linarith have hhi : log (seedScale k : ℝ) ≤ 3 * (k : ℝ) ^ 3 := by linarith [hlog.2] have hloghi := (log_le_log_iff hlogpos (by positivity)).mpr hhi rw [log_mul (by norm_num : (3 : ℝ) ≠ 0) (pow_ne_zero 3 hkR.ne'), log_pow] at hloghi norm_num only [Nat.cast_ofNat] at hloghi refine ⟨div_nonneg (log_nonneg hlo) hkR.le, ?_⟩ have hd := div_le_div_of_nonneg_right hloghi hkR.le calc _ ≤ (log 3 + 3 * log (k : ℝ)) / k := hd _ = log 3 / k + 3 * (log (k : ℝ) / k) := by ring exact squeeze_zero' (hbound.mono fun _ h ↦ h.1) (hbound.mono fun _ h ↦ h.2) hlim /-- For the explicit scale `ceil(exp(2*k^3))`, the seed loses no exponential rate, uniformly for any sequence of prime universes containing its bands. -/ theorem tendsto_seedScale_cost (P : ℕ → Finset ℕ) (hP : ∀ k p, p ∈ P k → p.Prime) {lam : ℝ} (hlam : 1 ≤ lam) (hB : ∀ᶠ k in atTop, practicalSeedPrimeUniverse (seedWindowCount (seedScale k)) ⊆ P k) : Tendsto (fun k : ℕ ↦ -log (practicalSeedTiltProbability (seedScale k) (P k) lam) / k) atTop (𝓝 0) := tendsto_neg_log_practicalSeedTiltProbability_div seedScale P hP hlam eventually_seedScale_gt hB tendsto_log_log_seedScale_div end Erdos859Verification end /- Inlined development module: PracticalSeedRepresentation.lean -/ section /- A practical seed converts a rough bounded-coefficient representation into actual membership in the problem's divisor-sum set. -/ open Finset Real namespace Erdos859Verification theorem coprime_prod_of_primes_above {P : Finset ℕ} {b L : ℕ} (hb : 0 < b) (hbL : b < L) (hP : ∀ p ∈ P, p.Prime) (hlarge : ∀ p ∈ P, L ≤ p) : Nat.Coprime b (∏ p ∈ P, p) := by apply Nat.Coprime.prod_right intro p hp apply Nat.Coprime.symm apply (hP p hp).coprime_iff_not_dvd.mpr intro hd have := Nat.le_of_dvd hb hd have := hlarge p hp omega /-- This is the deterministic interface needed after the rough divisor construction: bounded coefficients become distinct divisors of the integer. -/ theorem practicalSeed_mem_divisorSumSet {Z n : ℕ} {P : Finset ℕ} (hZ : 0 < Z) (hn : n ≠ 0) (hseed : HasPracticalSeed Z n) (hP : ∀ p ∈ P, p.Prime) (hlarge : ∀ p ∈ P, Z ^ 2 ≤ p) (hPdiv : (∏ p ∈ P, p) ∣ n) (c : ℕ → ℕ) (hc : ∀ d ∈ (∏ p ∈ P, p).divisors, c d ≤ Z) : n ∈ Erdos859.DivisorSumSet (∑ d ∈ (∏ p ∈ P, p).divisors, d * c d) := by obtain ⟨b, hb, hlo, hhi, hbdiv⟩ := hseed have hbpos : 0 < b := hZ.trans_le hlo have hprod0 : (∏ p ∈ P, p) ≠ 0 := prod_ne_zero_iff.mpr (fun p hp ↦ (hP p hp).ne_zero) have hcop := coprime_prod_of_primes_above hbpos hhi hP hlarge have hrep := bounded_coefficients_mem_divisorSumSet hb hbpos.ne' hprod0 hcop c (fun d hd ↦ (hc d hd).trans hlo) exact divisorSumSet_of_dvd (hcop.mul_dvd_of_dvd_of_dvd hbdiv hPdiv) hn hrep theorem seedScale_sq_lt_rough_cutoff {k : ℕ} (hk : 0 < k) : (seedScale k : ℝ) ^ 2 < exp (10 * (k : ℝ) ^ 3) := by have hk1 : (1 : ℝ) ≤ k := by exact_mod_cast hk have hpow : (1 : ℝ) ≤ (k : ℝ) ^ 3 := one_le_pow₀ hk1 have hlog := (log_ceil_exp_bounds (show 0 ≤ 2 * (k : ℝ) ^ 3 by positivity)).2 change log (seedScale k : ℝ) ≤ 2 * (k : ℝ) ^ 3 + log 2 at hlog have hseedpos : (0 : ℝ) < seedScale k := (exp_pos (2 * (k : ℝ) ^ 3)).trans_le (Nat.le_ceil _) apply (log_lt_iff_lt_exp (pow_pos hseedpos 2)).mp rw [log_pow] norm_num only [Nat.cast_ofNat] have hlog2 := log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) linarith theorem roughPrimeWindow_above_seedScale {k p : ℕ} {X : ℝ} (hk : 0 < k) (hp : p ∈ primeLogWindow (10 * (k : ℝ) ^ 3) X) : seedScale k ^ 2 < p := by have hlo := (mem_Ioc.mp (mem_filter.mp hp).1).1 have hpR := (Nat.floor_lt (exp_pos (10 * (k : ℝ) ^ 3)).le).mp hlo exact_mod_cast (seedScale_sq_lt_rough_cutoff hk).trans hpR end Erdos859Verification end /- Inlined development module: DivisorIntervalDyadic.lean -/ section /- Finite dyadic reduction of the divisor-interval upper bound. -/ open Filter Finset open scoped Topology namespace Erdos859Verification /-- Natural densities are subadditive under a finite cover, even when the covering sets overlap. -/ theorem density_le_sum_of_finite_cover {A : Set ℕ} {d : ℝ} {I : Finset ℕ} {B : ℕ → Set ℕ} {e : ℕ → ℝ} (hA : A.HasDensity d) (hB : ∀ j ∈ I, (B j).HasDensity (e j)) (hcover : ∀ n ∈ A, ∃ j ∈ I, n ∈ B j) : d ≤ ∑ j ∈ I, e j := by classical have hsum := tendsto_finsetSum I hB apply le_of_tendsto_of_tendsto' hA hsum intro N rw [partialDensity_eq_indicator_mean] simp_rw [partialDensity_eq_indicator_mean, ← sum_div] apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg N) rw [sum_comm] apply sum_le_sum intro n _ have hnonneg (j : ℕ) : 0 ≤ (B j).indicator (fun _ ↦ (1 : ℝ)) n := by by_cases hn : n ∈ B j <;> simp [hn] by_cases hn : n ∈ A · obtain ⟨j, hj, hnj⟩ := hcover n hn rw [Set.indicator_of_mem hn] calc (1 : ℝ) = (B j).indicator (fun _ ↦ (1 : ℝ)) n := by rw [Set.indicator_of_mem hnj] _ ≤ ∑ j ∈ I, (B j).indicator (fun _ ↦ (1 : ℝ)) n := single_le_sum (fun i _ ↦ hnonneg i) hj · rw [Set.indicator_of_notMem hn] exact sum_nonneg (fun j _ ↦ hnonneg j) /-- A divisor between the endpoints of a finite chain crosses some consecutive pair of endpoints. No monotonicity assumption is needed in this direction. -/ theorem divisorIntervalSet_chain_cover (a : ℕ → ℕ) (J : ℕ) : ∀ n ∈ DivisorIntervalSet (a J) (a 0), ∃ j ∈ range J, n ∈ DivisorIntervalSet (a (j + 1)) (a j) := by induction J with | zero => rintro n ⟨d, hlo, hhi, _⟩ exact False.elim (not_lt_of_ge hhi hlo) | succ J ih => rintro n ⟨d, hlo, hhi, hd⟩ by_cases hm : a J < d · obtain ⟨j, hj, hnj⟩ := ih n ⟨d, hm, hhi, hd⟩ exact ⟨j, mem_range.mpr (lt_trans (mem_range.mp hj) (Nat.lt_succ_self J)), hnj⟩ · exact ⟨J, mem_range.mpr (Nat.lt_succ_self J), d, hlo, le_of_not_gt hm, hd⟩ theorem divisorIntervalDensity_le_sum_chain (a : ℕ → ℕ) (J : ℕ) : divisorIntervalDensity (a J) (a 0) ≤ ∑ j ∈ range J, divisorIntervalDensity (a (j + 1)) (a j) := density_le_sum_of_finite_cover (divisorInterval_hasDensity _ _) (fun _ _ ↦ divisorInterval_hasDensity _ _) (divisorIntervalSet_chain_cover a J) /-- Exact integer division gives the half-open dyadic cover, including all rounding at the endpoints. -/ theorem divisorIntervalDensity_le_sum_dyadic (t J : ℕ) : divisorIntervalDensity (t / 2 ^ J) t ≤ ∑ j ∈ range J, divisorIntervalDensity (t / 2 ^ (j + 1)) (t / 2 ^ j) := by simpa using divisorIntervalDensity_le_sum_chain (fun j ↦ t / 2 ^ j) J /-- A singleton divisor condition has its usual reciprocal density. -/ theorem divisorCondition_hasDensity {d : ℕ} (hd : 0 < d) : {n : ℕ | d ∣ n}.HasDensity (1 / (d : ℝ)) := by apply hasDensity_of_indicator_mean (tendsto_mean_dvd_indicator hd) exact Filter.Eventually.of_forall (fun n ↦ by simp [Set.indicator_apply]) /-- Rounding a real dyadic interval can add one integer at its upper end. This lemma separates that one divisor from an exact integer-ratio interval. -/ theorem divisorIntervalDensity_le_double_add {y z : ℕ} (hz : z ≤ 2 * y + 1) : divisorIntervalDensity y z ≤ divisorIntervalDensity y (2 * y) + 1 / ((2 * y + 1 : ℕ) : ℝ) := by classical let B : ℕ → Set ℕ := fun j ↦ if j = 0 then DivisorIntervalSet y (2 * y) else {n : ℕ | 2 * y + 1 ∣ n} let e : ℕ → ℝ := fun j ↦ if j = 0 then divisorIntervalDensity y (2 * y) else 1 / ((2 * y + 1 : ℕ) : ℝ) have hB : ∀ j ∈ ({0, 1} : Finset ℕ), (B j).HasDensity (e j) := by intro j hj simp only [mem_insert, mem_singleton] at hj rcases hj with rfl | rfl · simpa [B, e] using divisorInterval_hasDensity y (2 * y) · simpa [B, e] using divisorCondition_hasDensity (by omega : 0 < 2 * y + 1) have hc : ∀ n ∈ DivisorIntervalSet y z, ∃ j ∈ ({0, 1} : Finset ℕ), n ∈ B j := by rintro n ⟨d, hlo, hhi, hd⟩ by_cases hdy : d ≤ 2 * y · exact ⟨0, by simp, by simpa [B] using (show n ∈ DivisorIntervalSet y (2 * y) from ⟨d, hlo, hdy, hd⟩)⟩ · have heq : d = 2 * y + 1 := by omega exact ⟨1, by simp, by simpa [B, heq] using hd⟩ simpa [e] using density_le_sum_of_finite_cover (divisorInterval_hasDensity y z) hB hc theorem nat_dyadic_quotient_le_double_add (t j : ℕ) : t / 2 ^ j ≤ 2 * (t / 2 ^ (j + 1)) + 1 := by rw [pow_succ, ← Nat.div_div_eq_div_mul] omega /-- The general divisor interval reduces to fixed-ratio natural intervals and an explicit harmless correction for every rounded endpoint. -/ theorem divisorIntervalDensity_le_sum_fixed_ratio (t J : ℕ) : divisorIntervalDensity (t / 2 ^ J) t ≤ ∑ j ∈ range J, (divisorIntervalDensity (t / 2 ^ (j + 1)) (2 * (t / 2 ^ (j + 1))) + 1 / ((2 * (t / 2 ^ (j + 1)) + 1 : ℕ) : ℝ)) := by apply (divisorIntervalDensity_le_sum_dyadic t J).trans exact sum_le_sum (fun j _ ↦ divisorIntervalDensity_le_double_add (nat_dyadic_quotient_le_double_add t j)) /-- Combine the exact small-divisor estimate with the finite dyadic reduction. No analytic divisor-interval bound is assumed here. -/ theorem divisorDensity_le_sum_fixed_ratio (t J : ℕ) (ht : 0 < t) : divisorDensity t ≤ (∑ j ∈ range J, (divisorIntervalDensity (t / 2 ^ (j + 1)) (2 * (t / 2 ^ (j + 1))) + 1 / ((2 * (t / 2 ^ (j + 1)) + 1 : ℕ) : ℝ))) + ((t / 2 ^ J : ℕ) : ℝ) / t := by exact (divisorDensity_le_intervalDensity_add t (t / 2 ^ J) ht).trans (add_le_add (divisorIntervalDensity_le_sum_fixed_ratio t J) le_rfl) theorem nat_dyadic_quotient_antitone (t : ℕ) : Antitone (fun j : ℕ ↦ t / 2 ^ j) := by intro i j hij exact Nat.div_le_div_left (Nat.pow_le_pow_right (by omega : 0 < 2) hij) (by positivity) /-- All rounded-endpoint corrections are bounded using the lowest dyadic endpoint. -/ theorem sum_dyadic_endpoint_correction_le (t J : ℕ) : (∑ j ∈ range J, 1 / ((2 * (t / 2 ^ (j + 1)) + 1 : ℕ) : ℝ)) ≤ (J : ℝ) / ((2 * (t / 2 ^ J) + 1 : ℕ) : ℝ) := by calc _ ≤ ∑ _j ∈ range J, 1 / ((2 * (t / 2 ^ J) + 1 : ℕ) : ℝ) := by apply sum_le_sum intro j hj apply one_div_le_one_div_of_le (by positivity) exact_mod_cast Nat.add_le_add_right (Nat.mul_le_mul_left 2 (nat_dyadic_quotient_antitone t (mem_range.mp hj))) 1 _ = _ := by simp [div_eq_mul_inv] theorem dyadic_small_divisor_error_le (t J : ℕ) (ht : 0 < t) : ((t / 2 ^ J : ℕ) : ℝ) / t ≤ 1 / (2 : ℝ) ^ J := by have htR : (0 : ℝ) < t := by exact_mod_cast ht calc _ ≤ ((t : ℝ) / ((2 ^ J : ℕ) : ℝ)) / t := div_le_div_of_nonneg_right Nat.cast_div_le htR.le _ = _ := by push_cast; field_simp /-- A uniform fixed-ratio estimate on the finitely many dyadic endpoints implies the needed upper estimate, with both discretization errors explicit. -/ theorem divisorDensity_le_of_uniform_fixed_ratio (t J : ℕ) (ht : 0 < t) (B : ℝ) (hB : ∀ j < J, divisorIntervalDensity (t / 2 ^ (j + 1)) (2 * (t / 2 ^ (j + 1))) ≤ B) : divisorDensity t ≤ (J : ℝ) * B + (J : ℝ) / ((2 * (t / 2 ^ J) + 1 : ℕ) : ℝ) + 1 / (2 : ℝ) ^ J := by have hsum : (∑ j ∈ range J, divisorIntervalDensity (t / 2 ^ (j + 1)) (2 * (t / 2 ^ (j + 1)))) ≤ (J : ℝ) * B := by calc _ ≤ ∑ _j ∈ range J, B := sum_le_sum (fun j hj ↦ hB j (mem_range.mp hj)) _ = _ := by simp calc _ ≤ _ := divisorDensity_le_sum_fixed_ratio t J ht _ = (∑ j ∈ range J, divisorIntervalDensity (t / 2 ^ (j + 1)) (2 * (t / 2 ^ (j + 1)))) + (∑ j ∈ range J, 1 / ((2 * (t / 2 ^ (j + 1)) + 1 : ℕ) : ℝ)) + ((t / 2 ^ J : ℕ) : ℝ) / t := by rw [sum_add_distrib] _ ≤ _ := add_le_add (add_le_add hsum (sum_dyadic_endpoint_correction_le t J)) (dyadic_small_divisor_error_le t J ht) end Erdos859Verification end /- Inlined development module: PrimeAnticoncentration.lean -/ section /- Finite anti-concentration for reciprocal-weighted prime logarithms. -/ open Finset Real namespace Erdos859Verification theorem mem_primeLogWindow {a b : ℝ} {p : ℕ} : p ∈ primeLogWindow a b ↔ p.Prime ∧ a < log (p : ℝ) ∧ log (p : ℝ) ≤ b := by simp only [primeLogWindow, mem_filter, mem_Ioc] constructor · rintro ⟨⟨hlo, hhi⟩, hp⟩ have hpR : (0 : ℝ) < p := by exact_mod_cast hp.pos exact ⟨hp, (lt_log_iff_exp_lt hpR).mpr ((Nat.floor_lt (exp_pos _).le).mp hlo), (log_le_iff_le_exp hpR).mpr ((Nat.le_floor_iff (exp_pos _).le).mp hhi)⟩ · rintro ⟨hp, hlo, hhi⟩ have hpR : (0 : ℝ) < p := by exact_mod_cast hp.pos exact ⟨⟨(Nat.floor_lt (exp_pos _).le).mpr ((lt_log_iff_exp_lt hpR).mp hlo), (Nat.le_floor_iff (exp_pos _).le).mpr ((log_le_iff_le_exp hpR).mp hhi)⟩, hp⟩ /-- A closed interval is enlarged by one on its left to handle possible prime atoms at the endpoint. The estimate is uniform in its location. -/ theorem primeLogWindow_interval_mass_upper {a b u h : ℝ} (ha : log 2 ≤ a) (hh : 0 ≤ h) : (∑ p ∈ (primeLogWindow a b).filter (fun p : ℕ ↦ u ≤ log (p : ℝ) ∧ log (p : ℝ) ≤ u + h), 1 / (p : ℝ)) ≤ (h + 1 + 2 * mertensErrorConstant) / a := by classical let Q := (primeLogWindow a b).filter (fun p : ℕ ↦ u ≤ log (p : ℝ) ∧ log (p : ℝ) ≤ u + h) change (∑ p ∈ Q, 1 / (p : ℝ)) ≤ _ have ha0 : 0 < a := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le ha have hnum : 0 ≤ h + 1 + 2 * mertensErrorConstant := by positivity [mertensErrorConstant_pos] by_cases hQ : Q.Nonempty · have hsub : Q ⊆ primeLogWindow (max a (u - 1)) (u + h) := by intro p hp obtain ⟨hpband, hpinterval⟩ := mem_filter.mp hp obtain ⟨hpprime, hpa, _hpb⟩ := mem_primeLogWindow.mp hpband exact mem_primeLogWindow.mpr ⟨hpprime, max_lt hpa (by linarith [hpinterval.1]), hpinterval.2⟩ obtain ⟨p, hp⟩ := hQ have hwindow := mem_primeLogWindow.mp (hsub hp) have hab : max a (u - 1) ≤ u + h := hwindow.2.1.le.trans hwindow.2.2 have hlow : a ≤ max a (u - 1) := le_max_left _ _ have hwidth : u + h - max a (u - 1) + 2 * mertensErrorConstant ≤ h + 1 + 2 * mertensErrorConstant := by have := le_max_right a (u - 1) linarith calc _ ≤ primeLogWindowMass (max a (u - 1)) (u + h) := by exact sum_le_sum_of_subset_of_nonneg hsub (fun _ _ _ ↦ by positivity) _ ≤ (u + h - max a (u - 1) + 2 * mertensErrorConstant) / max a (u - 1) := primeLogWindowMass_upper (ha.trans hlow) hab _ ≤ (h + 1 + 2 * mertensErrorConstant) / max a (u - 1) := div_le_div_of_nonneg_right hwidth (ha0.trans_le hlow).le _ ≤ _ := div_le_div_of_nonneg_left hnum ha0 hlow · have hQ0 : Q = ∅ := not_nonempty_iff_eq_empty.mp hQ rw [hQ0, sum_empty] exact div_nonneg hnum ha0.le noncomputable def primeLogMarkWeight (a b : ℝ) (p : ℕ) : ℝ := (1 / (p : ℝ)) / primeLogWindowMass a b theorem sum_primeLogMarkWeight {a b : ℝ} (hmass : 0 < primeLogWindowMass a b) : ∑ p ∈ primeLogWindow a b, primeLogMarkWeight a b p = 1 := by simp only [primeLogMarkWeight, ← sum_div] exact div_self hmass.ne' /-- The finite mark law in a dyadic logarithmic band has small-ball probability bounded by a constant times `(h+1)/a`. -/ theorem primeLogMark_smallBall {a u h : ℝ} (ha : log 2 ≤ a) (hlarge : 4 * mertensErrorConstant ≤ a * log 2) (hh : 0 ≤ h) : (∑ p ∈ (primeLogWindow a (2 * a)).filter (fun p : ℕ ↦ |log (p : ℝ) - u| ≤ h), primeLogMarkWeight a (2 * a) p) ≤ ((4 + 4 * mertensErrorConstant) / log 2) * ((h + 1) / a) := by classical have hlog2 : 0 < log (2 : ℝ) := log_pos (by norm_num) have ha0 : 0 < a := hlog2.trans_le ha have hmass := primeLogWindowMass_dyadic_lower ha hlarge have hmasspos : 0 < primeLogWindowMass a (2 * a) := (half_pos hlog2).trans_le hmass have hfilter : (primeLogWindow a (2 * a)).filter (fun p : ℕ ↦ |log (p : ℝ) - u| ≤ h) = (primeLogWindow a (2 * a)).filter (fun p : ℕ ↦ u - h ≤ log (p : ℝ) ∧ log (p : ℝ) ≤ (u - h) + 2 * h) := by apply filter_congr intro p _ rw [abs_le] constructor <;> intro hlog <;> constructor <;> linarith [hlog.1, hlog.2] simp only [primeLogMarkWeight, ← sum_div] rw [hfilter] have hinterval := primeLogWindow_interval_mass_upper (b := 2 * a) (u := u - h) ha (show 0 ≤ 2 * h by positivity) have hnum : 0 ≤ (2 * h + 1 + 2 * mertensErrorConstant) / a := by positivity [mertensErrorConstant_pos] calc _ ≤ ((2 * h + 1 + 2 * mertensErrorConstant) / a) / primeLogWindowMass a (2 * a) := div_le_div_of_nonneg_right hinterval hmasspos.le _ ≤ ((2 * h + 1 + 2 * mertensErrorConstant) / a) / (log 2 / 2) := div_le_div_of_nonneg_left hnum (half_pos hlog2) hmass _ = (2 * (2 * h + 1 + 2 * mertensErrorConstant) / log 2) / a := by ring _ ≤ ((4 + 4 * mertensErrorConstant) * (h + 1) / log 2) / a := by apply div_le_div_of_nonneg_right _ ha0.le apply div_le_div_of_nonneg_right _ hlog2.le nlinarith [mertensErrorConstant_pos, mul_nonneg mertensErrorConstant_pos.le hh] _ = ((4 + 4 * mertensErrorConstant) / log 2) * ((h + 1) / a) := by ring end Erdos859Verification end /- Inlined development module: PrimeCountMoments.lean -/ section /- Exact count moments and finite Chernoff bounds for the tilted prime law. -/ open Finset Real namespace Erdos859Verification /-- The effective selection probability of a prime under the count tilt. -/ noncomputable def primeTiltSelectionProbability (lam : ℝ) (p : ℕ) : ℝ := lam / ((p : ℝ) + lam - 1) theorem primeTiltSelectionProbability_pos_lt_one {p : ℕ} (hp : p.Prime) {lam : ℝ} (hlam : 0 < lam) : 0 < primeTiltSelectionProbability lam p ∧ primeTiltSelectionProbability lam p < 1 := by have hp1 : (1 : ℝ) < p := by exact_mod_cast hp.one_lt have hd : 0 < (p : ℝ) + lam - 1 := by linarith exact ⟨div_pos hlam hd, (div_lt_one hd).mpr (by linarith)⟩ theorem primeTiltWeight_pos {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (T : Finset ℕ) : 0 < primeTiltWeight P lam T := div_pos (mul_pos (primePatternWeight_pos hP T) (pow_pos hlam _)) (primeTiltNormalizer_pos hP hlam) /-- Tilting twice multiplies the tilt parameters. This algebraic identity holds even before positivity assumptions are imposed. -/ theorem primeTiltWeight_count_moment (P : Finset ℕ) (lam z : ℝ) : ∑ T ∈ P.powerset, primeTiltWeight P lam T * z ^ T.card = primeTiltNormalizer P (lam * z) / primeTiltNormalizer P lam := by simp only [primeTiltWeight, div_mul_eq_mul_div, ← sum_div] congr 1 rw [← primePatternWeight_moment] apply sum_congr rfl intro T _ rw [mul_pow] ring theorem primeTiltNormalizer_ratio_eq_prod {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (z : ℝ) : primeTiltNormalizer P (lam * z) / primeTiltNormalizer P lam = ∏ p ∈ P, (1 + (z - 1) * primeTiltSelectionProbability lam p) := by unfold primeTiltNormalizer rw [← prod_div_distrib] apply prod_congr rfl intro p hp have hp0 : (p : ℝ) ≠ 0 := by exact_mod_cast (hP p hp).ne_zero have hp1 : (1 : ℝ) < p := by exact_mod_cast (hP p hp).one_lt have hd : (p : ℝ) + lam - 1 ≠ 0 := by linarith have hden : 1 + (lam - 1) / (p : ℝ) = ((p : ℝ) + lam - 1) / p := by field_simp ring rw [hden] unfold primeTiltSelectionProbability field_simp [hp0, hd] ring theorem primeTilt_count_factor_pos {p : ℕ} (hp : p.Prime) {lam z : ℝ} (hlam : 0 < lam) (hz : 0 < z) : 0 < 1 + (z - 1) * primeTiltSelectionProbability lam p := by obtain ⟨hq0, hq1⟩ := primeTiltSelectionProbability_pos_lt_one hp hlam have hproduct := mul_pos hz hq0 nlinarith /-- The logarithmic Bernoulli moment bound also applies to `0 < z < 1`, which is the range needed for lower count tails. -/ theorem log_primeTilt_count_factor_le {p : ℕ} (hp : p.Prime) {lam z : ℝ} (hlam : 0 < lam) (hz : 0 < z) : log (1 + (z - 1) * primeTiltSelectionProbability lam p) ≤ (z - 1) * primeTiltSelectionProbability lam p := by simpa using log_le_sub_one_of_pos (primeTilt_count_factor_pos hp hlam hz) /-- The finite tilted count moment is bounded by the Poisson-shaped exponential with its exact Bernoulli mean; no Poisson approximation is used. -/ theorem primeTiltWeight_count_moment_le_exp {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam z : ℝ} (hlam : 0 < lam) (hz : 0 < z) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * z ^ T.card) ≤ exp ((z - 1) * ∑ p ∈ P, primeTiltSelectionProbability lam p) := by rw [primeTiltWeight_count_moment, primeTiltNormalizer_ratio_eq_prod hP hlam, mul_sum, exp_sum] apply Finset.prod_le_prod · intro p hp exact (primeTilt_count_factor_pos (hP p hp) hlam hz).le · intro p hp exact (log_le_iff_le_exp (primeTilt_count_factor_pos (hP p hp) hlam hz)).mp (log_primeTilt_count_factor_le (hP p hp) hlam hz) theorem primeTiltWeight_exp_count_moment_le {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (s : ℝ) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * exp (s * T.card)) ≤ exp ((exp s - 1) * ∑ p ∈ P, primeTiltSelectionProbability lam p) := by simpa only [mul_comm s, exp_nat_mul] using primeTiltWeight_count_moment_le_exp hP hlam (exp_pos s) /-- A finite exponential Markov bound for any count event whose exponent is above the supplied threshold. -/ theorem primeTiltWeight_count_event_le {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (F : Finset ℕ → Prop) [DecidablePred F] (s a : ℝ) (hF : ∀ T ∈ P.powerset, F T → s * a ≤ s * (T.card : ℝ)) : (∑ T ∈ P.powerset.filter F, primeTiltWeight P lam T) ≤ exp ((exp s - 1) * (∑ p ∈ P, primeTiltSelectionProbability lam p) - s * a) := by have hmarkov : (∑ T ∈ P.powerset.filter F, primeTiltWeight P lam T) * exp (s * a) ≤ ∑ T ∈ P.powerset, primeTiltWeight P lam T * exp (s * T.card) := by rw [sum_mul] calc _ ≤ ∑ T ∈ P.powerset.filter F, primeTiltWeight P lam T * exp (s * T.card) := by apply sum_le_sum intro T hT exact mul_le_mul_of_nonneg_left (exp_le_exp.mpr (hF T (mem_filter.mp hT).1 (mem_filter.mp hT).2)) (primeTiltWeight_pos hP hlam T).le _ ≤ _ := sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun T _ _ ↦ mul_nonneg (primeTiltWeight_pos hP hlam T).le (exp_pos _).le) calc _ ≤ exp ((exp s - 1) * (∑ p ∈ P, primeTiltSelectionProbability lam p)) / exp (s * a) := (le_div_iff₀ (exp_pos _)).mpr (hmarkov.trans (primeTiltWeight_exp_count_moment_le hP hlam s)) _ = _ := (exp_sub _ _).symm /-- Chernoff's upper tail estimate, with an arbitrary nonnegative exponent. -/ theorem primeTiltWeight_count_upper_tail {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (a s : ℝ) (hs : 0 ≤ s) : (∑ T ∈ P.powerset.filter (fun T ↦ a ≤ (T.card : ℝ)), primeTiltWeight P lam T) ≤ exp ((exp s - 1) * (∑ p ∈ P, primeTiltSelectionProbability lam p) - s * a) := by apply primeTiltWeight_count_event_le hP hlam intro T _ hT exact mul_le_mul_of_nonneg_left hT hs /-- Chernoff's lower tail estimate, including the negative-exponent range used to control missing points in terminal prime bands. -/ theorem primeTiltWeight_count_lower_tail {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (a s : ℝ) (hs : s ≤ 0) : (∑ T ∈ P.powerset.filter (fun T ↦ (T.card : ℝ) ≤ a), primeTiltWeight P lam T) ≤ exp ((exp s - 1) * (∑ p ∈ P, primeTiltSelectionProbability lam p) - s * a) := by apply primeTiltWeight_count_event_le hP hlam intro T _ hT exact mul_le_mul_of_nonpos_left hT hs end Erdos859Verification end /- Inlined development module: PrimeTiltProjection.lean -/ section /- Exact marginal consistency and restricted-count tails for the tilted law. -/ open Finset Real namespace Erdos859Verification /-- Split a finite subset into its part inside `B` and its part outside `B`. This is an exact reindexing of the powerset, with no probability assumptions. -/ theorem sum_powerset_split_subset {P B : Finset ℕ} (hB : B ⊆ P) (G : Finset ℕ → Finset ℕ → ℝ) : (∑ T ∈ P.powerset, G (T ∩ B) (T \ B)) = ∑ U ∈ B.powerset, ∑ V ∈ (P \ B).powerset, G U V := by rw [← sum_product'] apply sum_bij (fun T _ ↦ (T ∩ B, T \ B)) · intro T hT apply mem_product.mpr constructor · exact mem_powerset.mpr inter_subset_right · apply mem_powerset.mpr intro p hp exact mem_sdiff.mpr ⟨mem_powerset.mp hT (mem_sdiff.mp hp).1, (mem_sdiff.mp hp).2⟩ · intro S _ T _ h have heq := congrArg (fun UV : Finset ℕ × Finset ℕ ↦ UV.2 ∪ UV.1) h simpa only [sdiff_union_inter] using heq · rintro ⟨U, V⟩ hUV obtain ⟨hU, hV⟩ := mem_product.mp hUV have hUB : U ⊆ B := mem_powerset.mp hU have hVD : V ⊆ P \ B := mem_powerset.mp hV refine ⟨U ∪ V, mem_powerset.mpr ?_, ?_⟩ · intro p hp rcases mem_union.mp hp with hp | hp · exact hB (hUB hp) · exact (mem_sdiff.mp (hVD hp)).1 · apply Prod.ext · apply Finset.ext intro p simp only [Finset.mem_inter, Finset.mem_union] constructor · rintro ⟨hp | hp, hpB⟩ · exact hp · exact False.elim ((mem_sdiff.mp (hVD hp)).2 hpB) · intro hp exact ⟨Or.inl hp, hUB hp⟩ · apply Finset.ext intro p simp only [Finset.mem_sdiff, Finset.mem_union] constructor · rintro ⟨hp | hp, hpB⟩ · exact False.elim (hpB (hUB hp)) · exact hp · intro hp exact ⟨Or.inr hp, (mem_sdiff.mp (hVD hp)).2⟩ · intro T _ rfl theorem primePatternWeight_split_universe {P B : Finset ℕ} (hB : B ⊆ P) (T : Finset ℕ) : primePatternWeight P T = primePatternWeight (P \ B) (T \ B) * primePatternWeight B (T ∩ B) := by unfold primePatternWeight rw [← prod_sdiff hB] congr 1 · apply prod_congr rfl intro p hp simp [(mem_sdiff.mp hp).2] · apply prod_congr rfl intro p hp simp [hp] theorem primeTiltNormalizer_split_universe {P B : Finset ℕ} (hB : B ⊆ P) (lam : ℝ) : primeTiltNormalizer P lam = primeTiltNormalizer (P \ B) lam * primeTiltNormalizer B lam := by exact (prod_sdiff hB).symm /-- The tilt itself factors across a partition of the ambient prime set. -/ theorem primeTiltWeight_split_universe {P B : Finset ℕ} (hB : B ⊆ P) (T : Finset ℕ) (lam : ℝ) : primeTiltWeight P lam T = primeTiltWeight B lam (T ∩ B) * primeTiltWeight (P \ B) lam (T \ B) := by simp only [primeTiltWeight, primePatternWeight_split_universe hB T, primeTiltNormalizer_split_universe hB lam] rw [← card_inter_add_card_sdiff T B, pow_add] simp only [div_eq_mul_inv, mul_inv_rev] ring /-- Exact consistency of the finite tilted prime laws under restriction to any smaller prime universe. -/ theorem prime_tilt_expectation_restrict {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) {lam : ℝ} (hlam : 0 < lam) (F : Finset ℕ → ℝ) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * F (T ∩ B)) = ∑ U ∈ B.powerset, primeTiltWeight B lam U * F U := by calc _ = ∑ T ∈ P.powerset, primeTiltWeight B lam (T ∩ B) * primeTiltWeight (P \ B) lam (T \ B) * F (T ∩ B) := by apply sum_congr rfl intro T _ rw [primeTiltWeight_split_universe hB] _ = ∑ U ∈ B.powerset, ∑ V ∈ (P \ B).powerset, primeTiltWeight B lam U * primeTiltWeight (P \ B) lam V * F U := sum_powerset_split_subset hB (fun U V ↦ primeTiltWeight B lam U * primeTiltWeight (P \ B) lam V * F U) _ = _ := by apply sum_congr rfl intro U _ calc _ = (primeTiltWeight B lam U * F U) * ∑ V ∈ (P \ B).powerset, primeTiltWeight (P \ B) lam V := by rw [mul_sum] apply sum_congr rfl intro V _ ring _ = _ := by rw [sum_primeTiltWeight (fun p hp ↦ hP p (mem_sdiff.mp hp).1) hlam, mul_one] theorem prime_tilt_event_restrict {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) {lam : ℝ} (hlam : 0 < lam) (F : Finset ℕ → Prop) [DecidablePred F] : (∑ T ∈ P.powerset.filter (fun T ↦ F (T ∩ B)), primeTiltWeight P lam T) = ∑ U ∈ B.powerset.filter F, primeTiltWeight B lam U := by simpa only [sum_filter, mul_ite, mul_one, mul_zero] using prime_tilt_expectation_restrict hP hB hlam (fun U ↦ if F U then 1 else 0) theorem primeTiltWeight_restricted_count_moment {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) {lam : ℝ} (hlam : 0 < lam) (z : ℝ) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * z ^ (T ∩ B).card) = primeTiltNormalizer B (lam * z) / primeTiltNormalizer B lam := by rw [prime_tilt_expectation_restrict hP hB hlam (fun U ↦ z ^ U.card), primeTiltWeight_count_moment] theorem primeTiltWeight_restricted_exp_count_moment_le {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) {lam : ℝ} (hlam : 0 < lam) (s : ℝ) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * exp (s * (T ∩ B).card)) ≤ exp ((exp s - 1) * ∑ p ∈ B, primeTiltSelectionProbability lam p) := by rw [prime_tilt_expectation_restrict hP hB hlam (fun U ↦ exp (s * U.card))] exact primeTiltWeight_exp_count_moment_le (fun p hp ↦ hP p (hB hp)) hlam s theorem primeTiltWeight_restricted_count_lower_tail {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) {lam : ℝ} (hlam : 0 < lam) (a s : ℝ) (hs : s ≤ 0) : (∑ T ∈ P.powerset.filter (fun T ↦ ((T ∩ B).card : ℝ) ≤ a), primeTiltWeight P lam T) ≤ exp ((exp s - 1) * (∑ p ∈ B, primeTiltSelectionProbability lam p) - s * a) := by rw [prime_tilt_event_restrict hP hB hlam (fun U ↦ (U.card : ℝ) ≤ a)] exact primeTiltWeight_count_lower_tail (fun p hp ↦ hP p (hB hp)) hlam a s hs theorem primeTiltWeight_restricted_count_upper_tail {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) {lam : ℝ} (hlam : 0 < lam) (a s : ℝ) (hs : 0 ≤ s) : (∑ T ∈ P.powerset.filter (fun T ↦ a ≤ ((T ∩ B).card : ℝ)), primeTiltWeight P lam T) ≤ exp ((exp s - 1) * (∑ p ∈ B, primeTiltSelectionProbability lam p) - s * a) := by rw [prime_tilt_event_restrict hP hB hlam (fun U ↦ a ≤ (U.card : ℝ))] exact primeTiltWeight_count_upper_tail (fun p hp ↦ hP p (hB hp)) hlam a s hs end Erdos859Verification end /- Inlined development module: GeometricCollision.lean -/ section /- The reverse count barrier makes the finite collision series summable. -/ open Finset Real namespace Erdos859Verification /-- Here `r` counts the bands above the candidate highest differing band. The strict surplus over one selected mark per band gives geometric decay. -/ theorem geometric_collision_sum_bound {k : ℕ} {s : ℕ → ℝ} {A eps D : ℝ} (hA : 0 < A) (heps : 0 < eps) (hs : ∀ r < k, (1 + eps) * (r : ℝ) - D ≤ s r) : (∑ r ∈ range k, (2 : ℝ) ^ (-s r) / (A * (2 : ℝ) ^ (k - 1 - r))) ≤ (2 : ℝ) ^ (D + 1) / (A * (2 : ℝ) ^ k * (1 - (2 : ℝ) ^ (-eps))) := by let q : ℝ := (2 : ℝ) ^ (-eps) let C : ℝ := (2 : ℝ) ^ (D + 1) / (A * (2 : ℝ) ^ k) have hq0 : 0 < q := rpow_pos_of_pos (by norm_num) _ have hq1 : q < 1 := rpow_lt_one_of_one_lt_of_neg (by norm_num) (neg_neg_of_pos heps) have hC : 0 ≤ C := by positivity have heach (r : ℕ) (hr : r < k) : (2 : ℝ) ^ (-s r) / (A * (2 : ℝ) ^ (k - 1 - r)) ≤ C * q ^ r := by have hpow : (2 : ℝ) ^ (-s r) ≤ (2 : ℝ) ^ (D - (1 + eps) * (r : ℝ)) := rpow_le_rpow_of_exponent_le (by norm_num) (by linarith [hs r hr]) have hcast : ((k - 1 - r : ℕ) : ℝ) = (k : ℝ) - 1 - r := by rw [Nat.cast_sub (by omega : r ≤ k - 1), Nat.cast_sub (by omega : 1 ≤ k), Nat.cast_one] calc _ ≤ (2 : ℝ) ^ (D - (1 + eps) * (r : ℝ)) / (A * (2 : ℝ) ^ (k - 1 - r)) := div_le_div_of_nonneg_right hpow (by positivity) _ = (2 : ℝ) ^ (D - (1 + eps) * (r : ℝ) - (k - 1 - r : ℕ)) / A := by rw [rpow_sub (by norm_num : (0 : ℝ) < 2) (D - (1 + eps) * (r : ℝ)) ((k - 1 - r : ℕ) : ℝ), rpow_natCast] ring _ = (2 : ℝ) ^ ((D + 1 - (k : ℝ)) + (-eps) * (r : ℝ)) / A := by rw [hcast] congr 2 ring _ = C * q ^ r := by rw [rpow_add (by norm_num : (0 : ℝ) < 2), rpow_mul (by norm_num : (0 : ℝ) ≤ 2), rpow_natCast, rpow_sub (by norm_num : (0 : ℝ) < 2), rpow_natCast] dsimp [C, q] ring have hgeom : (∑ r ∈ range k, q ^ r) ≤ 1 / (1 - q) := by simpa using (geom_sum_Ico_le_of_lt_one (m := 0) (n := k) hq0.le hq1) calc _ ≤ ∑ r ∈ range k, C * q ^ r := sum_le_sum (fun r hr ↦ heach r (mem_range.mp hr)) _ = C * ∑ r ∈ range k, q ^ r := by rw [mul_sum] _ ≤ C * (1 / (1 - q)) := mul_le_mul_of_nonneg_left hgeom hC _ = _ := by dsimp [C, q] simp only [div_mul_eq_div_div] ring end Erdos859Verification end /- Inlined development module: ChernoffParameters.lean -/ section /- Fixed parameters for a uniform reverse count barrier. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification /-- An explicit small negative tilt separates any positive threshold below the mean. Only `1+x ≤ exp x` is needed. -/ theorem exists_positive_chernoff_rate {v mu : ℝ} (hv : 0 < v) (hvm : v < mu) : ∃ theta : ℝ, 0 < theta ∧ exp (theta * v + mu * (exp (-theta) - 1)) < 1 := by let theta : ℝ := (mu - v) / (2 * v) have ht : 0 < theta := div_pos (sub_pos.mpr hvm) (by positivity) have hden : 0 < 1 + theta := by linarith have hmu : 0 < mu := hv.trans hvm have hgap : v * (1 + theta) < mu := by dsimp [theta] field_simp nlinarith [mul_pos hv (sub_pos.mpr hvm)] have he : exp (-theta) ≤ 1 / (1 + theta) := by rw [exp_neg, ← one_div] exact one_div_le_one_div_of_le hden (by linarith [add_one_le_exp theta]) refine ⟨theta, ht, exp_lt_one_iff.mpr ?_⟩ calc _ ≤ theta * v + mu * (1 / (1 + theta) - 1) := add_le_add le_rfl (mul_le_mul_of_nonneg_left (sub_le_sub_right he 1) hmu.le) _ = theta / (1 + theta) * (v * (1 + theta) - mu) := by field_simp; ring _ < 0 := mul_neg_of_pos_of_neg (div_pos ht hden) (sub_neg.mpr hgap) /-- One fixed offset controls every finite geometric union bound. -/ theorem exists_geometric_tail_offset {theta R err : ℝ} (ht : 0 < theta) (hR0 : 0 < R) (hR1 : R < 1) (herr : 0 < err) : ∃ D : ℕ, ∀ k : ℕ, exp (-theta * (D : ℝ)) * (∑ ell ∈ range k, R ^ (ell + 1)) ≤ err := by have hq0 : 0 ≤ exp (-theta) := (exp_pos _).le have hq1 : exp (-theta) < 1 := exp_lt_one_iff.mpr (neg_neg_of_pos ht) have hlim : Tendsto (fun D : ℕ ↦ exp (-theta) ^ D * (R / (1 - R))) atTop (𝓝 0) := by simpa using (tendsto_pow_atTop_nhds_zero_of_lt_one hq0 hq1).mul_const (R / (1 - R)) obtain ⟨D, hD⟩ := (hlim.eventually_lt_const herr).exists refine ⟨D, fun k ↦ ?_⟩ have hgeom : (∑ ell ∈ range k, R ^ (ell + 1)) ≤ R / (1 - R) := by have h : (∑ ell ∈ range k, R ^ ell) ≤ 1 / (1 - R) := by simpa using geom_sum_Ico_le_of_lt_one (m := 0) (n := k) hR0.le hR1 calc _ = R * ∑ ell ∈ range k, R ^ ell := by simp only [pow_succ, mul_sum, mul_comm] _ ≤ R * (1 / (1 - R)) := mul_le_mul_of_nonneg_left h hR0.le _ = _ := by ring have heq : exp (-theta * (D : ℝ)) = exp (-theta) ^ D := by rw [mul_comm, exp_nat_mul] rw [heq] exact (mul_le_mul_of_nonneg_left hgeom (pow_nonneg hq0 D)).trans hD.le end Erdos859Verification end /- Inlined development module: PrimeBandMeans.lean -/ section /- Exact tilted prime counts retain the critical mean `lam * log 2`. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification theorem primeTiltSelectionProbability_error {p : ℕ} (hp : p.Prime) {lam : ℝ} (hlam : 1 ≤ lam) : 0 ≤ lam / (p : ℝ) - primeTiltSelectionProbability lam p ∧ lam / (p : ℝ) - primeTiltSelectionProbability lam p ≤ lam * (lam - 1) / (p : ℝ) ^ 2 := by have hp0 : (0 : ℝ) < p := by exact_mod_cast hp.pos have hd : 0 < (p : ℝ) + lam - 1 := by linarith have hnum : 0 ≤ lam * (lam - 1) := mul_nonneg (by linarith) (by linarith) have heq : lam / (p : ℝ) - primeTiltSelectionProbability lam p = lam * (lam - 1) / ((p : ℝ) * ((p : ℝ) + lam - 1)) := by unfold primeTiltSelectionProbability field_simp ring rw [heq] exact ⟨div_nonneg hnum (mul_pos hp0 hd).le, div_le_div_of_nonneg_left hnum (pow_pos hp0 2) (by nlinarith)⟩ theorem primeLogWindow_reciprocalSquare_le {a b : ℝ} : (∑ p ∈ primeLogWindow a b, 1 / (p : ℝ) ^ 2) ≤ exp (-a) * primeLogWindowMass a b := by change (∑ p ∈ primeLogWindow a b, 1 / (p : ℝ) ^ 2) ≤ exp (-a) * ∑ p ∈ primeLogWindow a b, 1 / (p : ℝ) rw [mul_sum] apply sum_le_sum intro p hp have hmem := mem_primeLogWindow.mp hp have hp0 : (0 : ℝ) < p := by exact_mod_cast hmem.1.pos have hrecip : 1 / (p : ℝ) ≤ exp (-a) := by rw [exp_neg, ← one_div] exact one_div_le_one_div_of_le (exp_pos a) ((lt_log_iff_exp_lt hp0).mp hmem.2.1).le calc _ = (1 / (p : ℝ)) * (1 / (p : ℝ)) := by ring _ ≤ _ := mul_le_mul_of_nonneg_right hrecip (by positivity) theorem primeLogWindow_tilt_mean_error {a b lam : ℝ} (hlam : 1 ≤ lam) : 0 ≤ lam * primeLogWindowMass a b - (∑ p ∈ primeLogWindow a b, primeTiltSelectionProbability lam p) ∧ lam * primeLogWindowMass a b - (∑ p ∈ primeLogWindow a b, primeTiltSelectionProbability lam p) ≤ lam * (lam - 1) * exp (-a) * primeLogWindowMass a b := by have heq : lam * primeLogWindowMass a b - (∑ p ∈ primeLogWindow a b, primeTiltSelectionProbability lam p) = ∑ p ∈ primeLogWindow a b, (lam / (p : ℝ) - primeTiltSelectionProbability lam p) := by simp only [sum_sub_distrib, primeLogWindowMass, primeLogWindow, mul_sum, mul_one_div] rw [heq] refine ⟨sum_nonneg (fun p hp ↦ (primeTiltSelectionProbability_error (primeLogWindow_prime a b p hp) hlam).1), ?_⟩ calc _ ≤ ∑ p ∈ primeLogWindow a b, lam * (lam - 1) / (p : ℝ) ^ 2 := sum_le_sum (fun p hp ↦ (primeTiltSelectionProbability_error (primeLogWindow_prime a b p hp) hlam).2) _ = lam * (lam - 1) * ∑ p ∈ primeLogWindow a b, 1 / (p : ℝ) ^ 2 := by simp only [mul_sum, mul_one_div] _ ≤ lam * (lam - 1) * (exp (-a) * primeLogWindowMass a b) := mul_le_mul_of_nonneg_left primeLogWindow_reciprocalSquare_le (mul_nonneg (by linarith) (by linarith)) _ = _ := by ring theorem tendsto_primeLogWindowMass_dyadic : Tendsto (fun a : ℝ ↦ primeLogWindowMass a (2 * a)) atTop (𝓝 (log 2)) := by apply tendsto_sub_nhds_zero_iff.mp have he : Tendsto (fun a : ℝ ↦ 2 * mertensErrorConstant / a) atTop (𝓝 0) := tendsto_const_nhds.div_atTop tendsto_id apply squeeze_zero_norm' _ he filter_upwards [eventually_ge_atTop (log (2 : ℝ))] with a ha have ha0 : 0 < a := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le ha have h := primeLogWindowMass_estimate ha (show a ≤ 2 * a by linarith) have hr : 2 * a / a = (2 : ℝ) := by field_simp rw [hr] at h simpa only [norm_eq_abs] using h theorem tendsto_primeLogWindow_tilt_mean {lam : ℝ} (hlam : 1 ≤ lam) : Tendsto (fun a : ℝ ↦ ∑ p ∈ primeLogWindow a (2 * a), primeTiltSelectionProbability lam p) atTop (𝓝 (lam * log 2)) := by have hmass := tendsto_primeLogWindowMass_dyadic have hexp : Tendsto (fun a : ℝ ↦ exp (-a)) atTop (𝓝 0) := tendsto_exp_atBot.comp tendsto_neg_atTop_atBot have herr : Tendsto (fun a : ℝ ↦ lam * (lam - 1) * exp (-a) * primeLogWindowMass a (2 * a)) atTop (𝓝 0) := by simpa using (hexp.const_mul (lam * (lam - 1))).mul hmass have hdiff : Tendsto (fun a : ℝ ↦ lam * primeLogWindowMass a (2 * a) - ∑ p ∈ primeLogWindow a (2 * a), primeTiltSelectionProbability lam p) atTop (𝓝 0) := by exact squeeze_zero (fun _ ↦ (primeLogWindow_tilt_mean_error hlam).1) (fun _ ↦ (primeLogWindow_tilt_mean_error hlam).2) herr simpa only [sub_sub_cancel, sub_zero] using (hmass.const_mul lam).sub hdiff /-- The threshold is the sharp one needed by the finite collision proof; using only half the Mertens mass would lose it. -/ theorem eventually_primeLogWindow_tilt_mean_bounds {lam : ℝ} (hlam : 1 ≤ lam) (hcritical : 1 < lam * log 2) : ∀ᶠ a : ℝ in atTop, (lam * log 2 + 1) / 2 ≤ (∑ p ∈ primeLogWindow a (2 * a), primeTiltSelectionProbability lam p) ∧ (∑ p ∈ primeLogWindow a (2 * a), primeTiltSelectionProbability lam p) ≤ lam * log 2 + 1 := by have ht := tendsto_primeLogWindow_tilt_mean hlam filter_upwards [ht.eventually_const_lt (show (lam * log 2 + 1) / 2 < lam * log 2 by linarith), ht.eventually_lt_const (show lam * log 2 < lam * log 2 + 1 by linarith)] with a hlo hhi exact ⟨hlo.le, hhi.le⟩ end Erdos859Verification end /- Inlined development module: ProgressionReciprocal.lean -/ section /- Reciprocal sums for separated integer sets and individual residue classes. -/ namespace Erdos859Verification open Finset Real theorem reciprocal_le_log_sub_div {x y q : ℝ} (hx : 0 < x) (hy : 0 < y) (hq : 0 < q) (hgap : q ≤ y - x) : 1 / y ≤ (log y - log x) / q := by have hlog := one_sub_inv_le_log_of_pos (div_pos hy hx) rw [inv_div, log_div hy.ne' hx.ne'] at hlog have hstep : q / y ≤ log y - log x := by calc q / y ≤ (y - x) / y := div_le_div_of_nonneg_right hgap hy.le _ = 1 - x / y := by field_simp _ ≤ log y - log x := hlog calc 1 / y = (q / y) / q := by field_simp _ ≤ (log y - log x) / q := div_le_div_of_nonneg_right hstep hq.le theorem sum_reciprocal_le_of_spacing (s : Finset ℕ) {L U q : ℝ} (hL : 0 < L) (hq : 0 < q) (hLU : L ≤ U) (hbound : ∀ n ∈ s, L ≤ (n : ℝ) ∧ (n : ℝ) ≤ U) (hgap : ∀ m ∈ s, ∀ n ∈ s, m < n → q ≤ (n : ℝ) - (m : ℝ)) : (∑ n ∈ s, 1 / (n : ℝ)) ≤ 1 / L + log (U / L) / q := by classical induction s using Finset.induction_on_max generalizing U with | empty => simp only [sum_empty] exact add_nonneg (one_div_nonneg.mpr hL.le) (div_nonneg (log_nonneg ((one_le_div hL).mpr hLU)) hq.le) | @insert a s hmax ih => have ha : a ∉ s := by intro has exact (lt_irrefl a) (hmax a has) have haL : L ≤ (a : ℝ) := (hbound a (mem_insert_self a s)).1 have haU : (a : ℝ) ≤ U := (hbound a (mem_insert_self a s)).2 have ha0 : 0 < (a : ℝ) := hL.trans_le haL rw [sum_insert ha] by_cases hs : s.Nonempty · let b := s.max' hs have hb : b ∈ s := max'_mem s hs have hbL : L ≤ (b : ℝ) := (hbound b (mem_insert_of_mem hb)).1 have hb0 : 0 < (b : ℝ) := hL.trans_le hbL have hba : b < a := hmax b hb have hbound' : ∀ n ∈ s, L ≤ (n : ℝ) ∧ (n : ℝ) ≤ (b : ℝ) := by intro n hn exact ⟨(hbound n (mem_insert_of_mem hn)).1, by exact_mod_cast le_max' s n hn⟩ have hgap' : ∀ m ∈ s, ∀ n ∈ s, m < n → q ≤ (n : ℝ) - (m : ℝ) := by intro m hm n hn hmn exact hgap m (mem_insert_of_mem hm) n (mem_insert_of_mem hn) hmn have hi := ih hbL hbound' hgap' have hstep := reciprocal_le_log_sub_div hb0 ha0 hq (hgap b (mem_insert_of_mem hb) a (mem_insert_self a s) hba) calc 1 / (a : ℝ) + ∑ n ∈ s, 1 / (n : ℝ) ≤ (log (a : ℝ) - log (b : ℝ)) / q + (1 / L + log ((b : ℝ) / L) / q) := add_le_add hstep hi _ = 1 / L + log ((a : ℝ) / L) / q := by rw [log_div hb0.ne' hL.ne', log_div ha0.ne' hL.ne'] ring _ ≤ 1 / L + log (U / L) / q := by apply add_le_add le_rfl apply div_le_div_of_nonneg_right _ hq.le exact log_le_log (div_pos ha0 hL) (div_le_div_of_nonneg_right haU hL.le) · have hs' : s = ∅ := not_nonempty_iff_eq_empty.mp hs rw [hs', sum_empty, add_zero] calc 1 / (a : ℝ) ≤ 1 / L := one_div_le_one_div_of_le hL haL _ ≤ 1 / L + log (U / L) / q := le_add_of_nonneg_right (div_nonneg (log_nonneg ((one_le_div hL).mpr hLU)) hq.le) theorem sum_reciprocal_modEq_le (s : Finset ℕ) {L U : ℝ} {q a : ℕ} (hL : 0 < L) (hq : 0 < q) (hLU : L ≤ U) (hbound : ∀ n ∈ s, L ≤ (n : ℝ) ∧ (n : ℝ) ≤ U) (hcongr : ∀ n ∈ s, Nat.ModEq q n a) : (∑ n ∈ s, 1 / (n : ℝ)) ≤ 1 / L + log (U / L) / (q : ℝ) := by apply sum_reciprocal_le_of_spacing s hL (by exact_mod_cast hq) hLU hbound intro m hm n hn hmn have hdvd : q ∣ n - m := ((hcongr m hm).trans (hcongr n hn).symm).dvd' have hle : q ≤ n - m := Nat.le_of_dvd (Nat.sub_pos_of_lt hmn) hdvd have hcast : (q : ℝ) ≤ ((n - m : ℕ) : ℝ) := by exact_mod_cast hle rwa [Nat.cast_sub hmn.le] at hcast theorem sum_reciprocal_Ioc_modEq_le {L U q a : ℕ} (hL : 0 < L) (hq : 0 < q) (hLU : L ≤ U) : (∑ n ∈ (Ioc L U).filter (fun n ↦ Nat.ModEq q n a), 1 / (n : ℝ)) ≤ 1 / (L : ℝ) + log ((U : ℝ) / (L : ℝ)) / (q : ℝ) := by apply sum_reciprocal_modEq_le _ (by exact_mod_cast hL) hq (by exact_mod_cast hLU) · intro n hn have hi := mem_Ioc.mp (mem_filter.mp hn).1 exact ⟨by exact_mod_cast hi.1.le, by exact_mod_cast hi.2⟩ · intro n hn exact (mem_filter.mp hn).2 theorem sum_reciprocal_real_window_modEq_le {L U : ℝ} {q a : ℕ} (hL : 0 < L) (hq : 0 < q) (hLU : L ≤ U) : (∑ n ∈ (Ioc ⌊L⌋₊ ⌊U⌋₊).filter (fun n ↦ Nat.ModEq q n a), 1 / (n : ℝ)) ≤ 1 / L + log (U / L) / (q : ℝ) := by apply sum_reciprocal_modEq_le _ hL hq hLU · intro n hn have hi := mem_Ioc.mp (mem_filter.mp hn).1 exact ⟨((Nat.floor_lt hL.le).mp hi.1).le, (Nat.le_floor_iff (hL.le.trans hLU)).mp hi.2⟩ · intro n hn exact (mem_filter.mp hn).2 theorem sum_reciprocal_log_window_modEq_le {v b : ℝ} {q a : ℕ} (hq : 0 < q) (hvb : v ≤ b) : (∑ n ∈ (Ioc ⌊exp v⌋₊ ⌊exp b⌋₊).filter (fun n ↦ Nat.ModEq q n a), 1 / (n : ℝ)) ≤ exp (-v) + (b - v) / (q : ℝ) := by have h := sum_reciprocal_real_window_modEq_le (a := a) (exp_pos v) hq (exp_le_exp.mpr hvb) simpa only [log_div (exp_ne_zero b) (exp_ne_zero v), log_exp, one_div, exp_neg] using h end Erdos859Verification end /- Inlined development module: BroadPrimeWindow.lean -/ section /- Broad logarithmic prime windows and uniform residue probabilities. -/ namespace Erdos859Verification open Finset Real theorem primeLogWindowMass_broad_lower {v eps : ℝ} (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) : eps / 4 ≤ primeLogWindowMass v ((1 + eps) * v) := by have hv0 : 0 < v := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv have hvb : v ≤ (1 + eps) * v := by nlinarith have hlog : eps / 2 ≤ log (1 + eps) := by calc eps / 2 ≤ 2 * eps / (eps + 2) := by apply (le_div_iff₀ (by linarith : 0 < eps + 2)).mpr nlinarith [mul_nonneg heps.le (sub_nonneg.mpr heps1)] _ ≤ log (1 + eps) := le_log_one_add_of_nonneg heps.le have herr : 2 * mertensErrorConstant / v ≤ eps / 4 := by apply (div_le_iff₀ hv0).mpr nlinarith have h := primeLogWindowMass_estimate hv hvb have hquot : (1 + eps) * v / v = 1 + eps := by field_simp rw [hquot] at h have hlo := (abs_le.mp h).1 linarith theorem primeLogWindowMass_broad_upper {v eps : ℝ} (hv : log 2 ≤ v) (heps : 0 < eps) (hlarge : 8 * mertensErrorConstant ≤ eps * v) : primeLogWindowMass v ((1 + eps) * v) ≤ 5 * eps / 4 := by have hv0 : 0 < v := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv have hvb : v ≤ (1 + eps) * v := by nlinarith have hlog : log (1 + eps) ≤ eps := by have h := log_le_sub_one_of_pos (by linarith : 0 < 1 + eps) linarith have herr : 2 * mertensErrorConstant / v ≤ eps / 4 := by apply (div_le_iff₀ hv0).mpr nlinarith have h := primeLogWindowMass_estimate hv hvb have hquot : (1 + eps) * v / v = 1 + eps := by field_simp rw [hquot] at h have hhi := (abs_le.mp h).2 linarith theorem primeLogWindow_residue_mass_upper {v b : ℝ} {q a : ℕ} (hq : 0 < q) (hvb : v ≤ b) : (∑ p ∈ (primeLogWindow v b).filter (fun p ↦ Nat.ModEq q p a), 1 / (p : ℝ)) ≤ exp (-v) + (b - v) / (q : ℝ) := by classical have hsub : (primeLogWindow v b).filter (fun p ↦ Nat.ModEq q p a) ⊆ (Ioc ⌊exp v⌋₊ ⌊exp b⌋₊).filter (fun p ↦ Nat.ModEq q p a) := by intro p hp obtain ⟨hpband, hpmod⟩ := mem_filter.mp hp exact mem_filter.mpr ⟨(mem_filter.mp hpband).1, hpmod⟩ calc _ ≤ ∑ p ∈ (Ioc ⌊exp v⌋₊ ⌊exp b⌋₊).filter (fun p ↦ Nat.ModEq q p a), 1 / (p : ℝ) := sum_le_sum_of_subset_of_nonneg hsub (fun _ _ _ ↦ by positivity) _ ≤ _ := sum_reciprocal_log_window_modEq_le hq hvb theorem primeLogMark_broad_residue_upper {v eps : ℝ} {q a : ℕ} (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) (hq : 0 < q) : (∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter (fun p ↦ Nat.ModEq q p a), primeLogMarkWeight v ((1 + eps) * v) p) ≤ 4 * v / (q : ℝ) + 4 * exp (-v) / eps := by classical have hv0 : 0 < v := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv have hvb : v ≤ (1 + eps) * v := by nlinarith have hq0 : (0 : ℝ) < q := by exact_mod_cast hq have hmass := primeLogWindowMass_broad_lower hv heps heps1 hlarge have hmasspos : 0 < primeLogWindowMass v ((1 + eps) * v) := (by positivity : 0 < eps / 4).trans_le hmass have hnum : 0 ≤ exp (-v) + ((1 + eps) * v - v) / (q : ℝ) := by positivity simp only [primeLogMarkWeight, ← sum_div] calc _ ≤ (exp (-v) + ((1 + eps) * v - v) / (q : ℝ)) / primeLogWindowMass v ((1 + eps) * v) := div_le_div_of_nonneg_right (primeLogWindow_residue_mass_upper hq hvb) hmasspos.le _ ≤ (exp (-v) + ((1 + eps) * v - v) / (q : ℝ)) / (eps / 4) := div_le_div_of_nonneg_left hnum (by positivity) hmass _ = _ := by field_simp; ring theorem primeLogMark_broad_atom_upper {v eps : ℝ} {p : ℕ} (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) (hp : p ∈ primeLogWindow v ((1 + eps) * v)) : primeLogMarkWeight v ((1 + eps) * v) p ≤ 4 * exp (-v) / eps := by obtain ⟨hpprime, hplog, _⟩ := mem_primeLogWindow.mp hp have hp0 : (0 : ℝ) < p := by exact_mod_cast hpprime.pos have hmass := primeLogWindowMass_broad_lower hv heps heps1 hlarge have hmasspos : 0 < primeLogWindowMass v ((1 + eps) * v) := (by positivity : 0 < eps / 4).trans_le hmass have hrecip : 1 / (p : ℝ) ≤ exp (-v) := by calc _ ≤ 1 / exp v := one_div_le_one_div_of_le (exp_pos v) ((lt_log_iff_exp_lt hp0).mp hplog).le _ = _ := by rw [exp_neg, one_div] unfold primeLogMarkWeight calc _ ≤ exp (-v) / primeLogWindowMass v ((1 + eps) * v) := div_le_div_of_nonneg_right hrecip hmasspos.le _ ≤ exp (-v) / (eps / 4) := div_le_div_of_nonneg_left (exp_pos (-v)).le (by positivity) hmass _ = _ := by ring end Erdos859Verification end /- Inlined development module: FiniteProductConcentration.lean -/ section /- Conditioning and concentration for finite independent weighted coordinates. -/ open Finset namespace Erdos859Verification noncomputable def finiteProductWeight {ι : Type*} [Fintype ι] {α : ι → Type*} (w : ∀ i, α i → ℝ) (x : ∀ i, α i) : ℝ := ∏ i, w i (x i) theorem finiteProductWeight_nonneg {ι : Type*} [Fintype ι] {α : ι → Type*} {w : ∀ i, α i → ℝ} (hw : ∀ i y, 0 ≤ w i y) (x : ∀ i, α i) : 0 ≤ finiteProductWeight w x := prod_nonneg (fun i _ ↦ hw i (x i)) theorem sum_finiteProductWeight {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} [∀ i, Fintype (α i)] (w : ∀ i, α i → ℝ) (hnorm : ∀ i, ∑ y, w i y = 1) : ∑ x : ∀ i, α i, finiteProductWeight w x = 1 := by classical simp only [finiteProductWeight, ← Fintype.prod_sum, hnorm, prod_const_one] /-- Averaging a uniform section bound against normalized nonnegative weights. -/ theorem finite_weighted_section_bound {α β : Type*} [Fintype α] [Fintype β] (u : α → ℝ) (v : β → ℝ) (F : α → β → ℝ) (c : ℝ) (hu : ∀ x, 0 ≤ u x) (hnorm : ∑ x, u x = 1) (hsection : ∀ x, ∑ y, v y * F x y ≤ c) : (∑ x, ∑ y, u x * v y * F x y) ≤ c := by calc _ = ∑ x, u x * (∑ y, v y * F x y) := by apply sum_congr rfl intro x _ rw [mul_sum] apply sum_congr rfl intro y _ ring _ ≤ ∑ x, u x * c := sum_le_sum (fun x _ ↦ mul_le_mul_of_nonneg_left (hsection x) (hu x)) _ = c := by rw [← sum_mul, hnorm, one_mul] theorem finiteProductWeight_split {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} (w : ∀ i, α i → ℝ) (i : ι) (x : ∀ i, α i) : finiteProductWeight w x = w i (x i) * (∏ j : {j : ι // j ≠ i}, w j (x j)) := by unfold finiteProductWeight rw [← mul_prod_erase univ (fun j ↦ w j (x j)) (mem_univ i)] congr 1 exact prod_subtype (univ.erase i) (by intro j; simp) (fun j ↦ w j (x j)) /-- The complete product expectation is bounded once every section in one coordinate is bounded. Coordinate types may depend on the index. -/ theorem finite_product_section_bound {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} [∀ i, Fintype (α i)] (w : ∀ i, α i → ℝ) (F : (∀ i, α i) → ℝ) (i : ι) (c : ℝ) (hw : ∀ i y, 0 ≤ w i y) (hnorm : ∀ i, ∑ y, w i y = 1) (hsection : ∀ z : ∀ j : {j : ι // j ≠ i}, α j, ∑ y, w i y * F ((Equiv.piSplitAt i α).symm (y, z)) ≤ c) : (∑ x : ∀ i, α i, finiteProductWeight w x * F x) ≤ c := by classical let v : (∀ j : {j : ι // j ≠ i}, α j) → ℝ := fun z ↦ ∏ j : {j : ι // j ≠ i}, w j (z j) have hv : ∀ z, 0 ≤ v z := fun z ↦ prod_nonneg (fun (j : {j : ι // j ≠ i}) _ ↦ hw j (z j)) have hvnorm : ∑ z, v z = 1 := sum_finiteProductWeight (fun j : {j : ι // j ≠ i} ↦ w j) (fun j ↦ hnorm j) have heq : (∑ x : ∀ i, α i, finiteProductWeight w x * F x) = ∑ z, ∑ y, v z * w i y * F ((Equiv.piSplitAt i α).symm (y, z)) := by rw [← (Equiv.piSplitAt i α).symm.sum_comp (fun x ↦ finiteProductWeight w x * F x), Fintype.sum_prod_type, sum_comm] apply sum_congr rfl intro z _ apply sum_congr rfl intro y _ rw [finiteProductWeight_split w i] have hrest : (∏ j : {j : ι // j ≠ i}, w j ((Equiv.piSplitAt i α).symm (y, z) j)) = v z := by apply prod_congr rfl intro j _ simp [Equiv.piSplitAt_symm_apply, j.property] rw [hrest] simp [Equiv.piSplitAt_symm_apply, mul_comm] rw [heq] exact finite_weighted_section_bound v (w i) (fun z y ↦ F ((Equiv.piSplitAt i α).symm (y, z))) c hv hvnorm hsection /-- A sign and a translation preserve a uniform one-dimensional small-ball bound. -/ theorem finite_weighted_affine_smallBall {α : Type*} [Fintype α] (w mark : α → ℝ) (h c s t e : ℝ) (he : e = 1 ∨ e = -1) (hsmall : ∀ u : ℝ, ∑ y, w y * (if |mark y - u| ≤ h then 1 else 0) ≤ c) : (∑ y, w y * (if |e * mark y + s - t| ≤ h then 1 else 0)) ≤ c := by classical rcases he with rfl | rfl · convert hsmall (t - s) using 1 apply sum_congr rfl intro y _ have heq : 1 * mark y + s - t = mark y - (t - s) := by ring rw [heq] · convert hsmall (s - t) using 1 apply sum_congr rfl intro y _ have heq : -1 * mark y + s - t = -(mark y - (s - t)) := by ring rw [heq, abs_neg] /-- A coordinate with a uniform small-ball bound controls any observable whose sections in that coordinate are signed translates of its mark. -/ theorem finite_product_smallBall_of_affine_sections {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} [∀ i, Fintype (α i)] (w : ∀ i, α i → ℝ) (F : (∀ i, α i) → ℝ) (i : ι) (mark : α i → ℝ) (h c t : ℝ) (hw : ∀ i y, 0 ≤ w i y) (hnorm : ∀ i, ∑ y, w i y = 1) (hsmall : ∀ u : ℝ, ∑ y, w i y * (if |mark y - u| ≤ h then 1 else 0) ≤ c) (haffine : ∀ z : ∀ j : {j : ι // j ≠ i}, α j, ∃ s e : ℝ, (e = 1 ∨ e = -1) ∧ ∀ y, F ((Equiv.piSplitAt i α).symm (y, z)) = e * mark y + s) : (∑ x : ∀ i, α i, finiteProductWeight w x * (if |F x - t| ≤ h then 1 else 0)) ≤ c := by classical apply finite_product_section_bound w (fun x ↦ if |F x - t| ≤ h then 1 else 0) i c hw hnorm intro z obtain ⟨s, e, he, hF⟩ := haffine z simp_rw [hF] exact finite_weighted_affine_smallBall (w i) mark h c s t e he hsmall theorem finite_sum_split {ι : Type*} [Fintype ι] [DecidableEq ι] (f : ι → ℝ) (i : ι) : (∑ j, f j) = f i + ∑ j : {j : ι // j ≠ i}, f j := by rw [← add_sum_erase univ f (mem_univ i)] congr 1 exact sum_subtype (univ.erase i) (by intro j; simp) f /-- In a signed sum of independent finite marks, one coefficient equal to `1` or `-1` transfers that coordinate's concentration bound to the sum. -/ theorem finite_product_sum_smallBall {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} [∀ i, Fintype (α i)] (w mark : ∀ i, α i → ℝ) (coeff : ι → ℝ) (i : ι) (h c t : ℝ) (hw : ∀ i y, 0 ≤ w i y) (hnorm : ∀ i, ∑ y, w i y = 1) (hcoeff : coeff i = 1 ∨ coeff i = -1) (hsmall : ∀ u : ℝ, ∑ y, w i y * (if |mark i y - u| ≤ h then 1 else 0) ≤ c) : (∑ x : ∀ i, α i, finiteProductWeight w x * (if |(∑ j, coeff j * mark j (x j)) - t| ≤ h then 1 else 0)) ≤ c := by classical apply finite_product_smallBall_of_affine_sections w (fun x ↦ ∑ j, coeff j * mark j (x j)) i (mark i) h c t hw hnorm hsmall intro z refine ⟨∑ j : {j : ι // j ≠ i}, coeff j * mark j (z j), coeff i, hcoeff, ?_⟩ intro y rw [finite_sum_split _ i] simp only [Equiv.piSplitAt_symm_apply] congr 1 apply sum_congr rfl intro j _ simp [j.property] /-- The checked reciprocal-prime estimate in the finite-type interface used by the product concentration lemmas. -/ theorem primeLogMark_subtype_smallBall {a u h : ℝ} (ha : Real.log 2 ≤ a) (hlarge : 4 * mertensErrorConstant ≤ a * Real.log 2) (hh : 0 ≤ h) : (∑ p : primeLogWindow a (2 * a), primeLogMarkWeight a (2 * a) p * (if |Real.log (p : ℕ) - u| ≤ h then 1 else 0)) ≤ ((4 + 4 * mertensErrorConstant) / Real.log 2) * ((h + 1) / a) := by classical let f : ℕ → ℝ := fun p ↦ primeLogMarkWeight a (2 * a) p * (if |Real.log (p : ℝ) - u| ≤ h then 1 else 0) change (∑ p : primeLogWindow a (2 * a), f p) ≤ _ rw [sum_coe_sort] simpa only [f, mul_ite, mul_one, mul_zero, ← sum_filter] using primeLogMark_smallBall (u := u) ha hlarge hh end Erdos859Verification end /- Inlined development module: FiniteReweighting.lean -/ section /- Quantitative comparison of conditioned and reweighted finite laws. -/ open Finset namespace Erdos859Verification theorem finite_normalized_reweight_bound {α : Type*} [Fintype α] (S : Finset α) (w H F : α → ℝ) {a b : ℝ} (ha : 0 < a) (hb : 0 ≤ b) (hw : ∀ x, 0 ≤ w x) (hF : ∀ x, 0 ≤ F x) (hHlow : ∀ x ∈ S, 1 ≤ H x) (hHhigh : ∀ x ∈ S, H x ≤ b) (hmass : a ≤ ∑ x ∈ S, w x) : (∑ x ∈ S, w x * H x * F x) / (∑ x ∈ S, w x * H x) ≤ (b / a) * ∑ x, w x * F x := by have hden : a ≤ ∑ x ∈ S, w x * H x := hmass.trans (sum_le_sum fun x hx ↦ le_mul_of_one_le_right (hw x) (hHlow x hx)) have hE : 0 ≤ ∑ x, w x * F x := sum_nonneg (fun x _ ↦ mul_nonneg (hw x) (hF x)) have hnum : (∑ x ∈ S, w x * H x * F x) ≤ b * ∑ x, w x * F x := by calc _ ≤ ∑ x ∈ S, b * (w x * F x) := by apply sum_le_sum intro x hx calc _ = H x * (w x * F x) := by ring _ ≤ _ := mul_le_mul_of_nonneg_right (hHhigh x hx) (mul_nonneg (hw x) (hF x)) _ ≤ ∑ x, b * (w x * F x) := sum_le_sum_of_subset_of_nonneg (subset_univ S) (fun x _ _ ↦ mul_nonneg hb (mul_nonneg (hw x) (hF x))) _ = _ := (mul_sum _ _ _).symm calc _ ≤ (b * ∑ x, w x * F x) / (∑ x ∈ S, w x * H x) := div_le_div_of_nonneg_right hnum (ha.trans_le hden).le _ ≤ (b * ∑ x, w x * F x) / a := div_le_div_of_nonneg_left (mul_nonneg hb hE) ha hden _ = _ := by ring /-- Conditioning on an event of mass at least three quarters and reweighting by a factor between one and three halves inflates nonnegative expectations by at most two. -/ theorem finite_normalized_reweight_le_two {α : Type*} [Fintype α] (S : Finset α) (w H F : α → ℝ) (hw : ∀ x, 0 ≤ w x) (hF : ∀ x, 0 ≤ F x) (hHlow : ∀ x ∈ S, 1 ≤ H x) (hHhigh : ∀ x ∈ S, H x ≤ 3 / 2) (hmass : (3 : ℝ) / 4 ≤ ∑ x ∈ S, w x) : (∑ x ∈ S, w x * H x * F x) / (∑ x ∈ S, w x * H x) ≤ 2 * ∑ x, w x * F x := by have h := finite_normalized_reweight_bound S w H F (by norm_num : (0 : ℝ) < 3 / 4) (by norm_num : (0 : ℝ) ≤ 3 / 2) hw hF hHlow hHhigh hmass norm_num at h exact h theorem finite_weighted_markov {α : Type*} (S : Finset α) (w F : α → ℝ) {t : ℝ} (ht : 0 < t) (hw : ∀ x ∈ S, 0 ≤ w x) (hF : ∀ x ∈ S, 0 ≤ F x) : (∑ x ∈ S with t ≤ F x, w x) ≤ (∑ x ∈ S, w x * F x) / t := by classical apply (le_div_iff₀ ht).mpr rw [sum_mul] calc _ ≤ ∑ x ∈ S with t ≤ F x, w x * F x := by apply sum_le_sum intro x hx exact mul_le_mul_of_nonneg_left (mem_filter.mp hx).2 (hw x (mem_filter.mp hx).1) _ ≤ _ := sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun x hx _ ↦ mul_nonneg (hw x hx) (hF x hx)) end Erdos859Verification end /- Inlined development module: PrimeReverseBarrier.lean -/ section /- A uniform finite reverse-count barrier from marginal Chernoff bounds. -/ open Finset Real namespace Erdos859Verification /-- A finite union bound for arbitrary nonnegative weights. Neither independence nor disjointness of the events is required. -/ theorem finite_weighted_union_bound (S : Finset (Finset ℕ)) (I : Finset ℕ) (w : Finset ℕ → ℝ) (hw : ∀ T ∈ S, 0 ≤ w T) (F : ℕ → Finset ℕ → Prop) [DecidableRel F] : (∑ T ∈ S.filter (fun T ↦ ∃ ell ∈ I, F ell T), w T) ≤ ∑ ell ∈ I, ∑ T ∈ S.filter (F ell), w T := by simp only [sum_filter] rw [sum_comm] apply sum_le_sum intro T hT have hnonneg (ell : ℕ) : 0 ≤ if F ell T then w T else 0 := by split_ifs · exact hw T hT · exact le_rfl split_ifs with h · obtain ⟨ell, hell, hF⟩ := h calc w T = if F ell T then w T else 0 := by rw [if_pos hF] _ ≤ ∑ ell ∈ I, if F ell T then w T else 0 := single_le_sum (fun ell _ ↦ hnonneg ell) hell · exact sum_nonneg (fun ell _ ↦ hnonneg ell) /-- One restricted lower tail is exponentially small in the number of terminal bands, provided its mean has the corresponding linear lower bound. -/ theorem primeTiltWeight_linear_barrier_failure_le {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) {lam : ℝ} (hlam : 0 < lam) (v mu theta : ℝ) (ht : 0 ≤ theta) (D ell : ℕ) (hmean : mu * (ell + 1 : ℕ) ≤ ∑ p ∈ B, primeTiltSelectionProbability lam p) : (∑ T ∈ P.powerset.filter (fun T ↦ ((T ∩ B).card : ℝ) ≤ v * (ell + 1 : ℕ) - D), primeTiltWeight P lam T) ≤ exp (-theta * (D : ℝ)) * exp (theta * v + mu * (exp (-theta) - 1)) ^ (ell + 1) := by have hneg : exp (-theta) - 1 ≤ 0 := by exact sub_nonpos.mpr (exp_le_one_iff.mpr (neg_nonpos.mpr ht)) calc _ ≤ exp ((exp (-theta) - 1) * (∑ p ∈ B, primeTiltSelectionProbability lam p) - (-theta) * (v * (ell + 1 : ℕ) - D)) := primeTiltWeight_restricted_count_lower_tail hP hB hlam (v * (ell + 1 : ℕ) - D) (-theta) (neg_nonpos.mpr ht) _ ≤ exp ((exp (-theta) - 1) * (mu * (ell + 1 : ℕ)) - (-theta) * (v * (ell + 1 : ℕ) - D)) := by apply exp_le_exp.mpr exact sub_le_sub_right (mul_le_mul_of_nonpos_left hmean hneg) _ _ = _ := by rw [← exp_nat_mul, ← exp_add] congr 1 ring /-- Failure of a reverse-count barrier at one of the finitely many scales. Using a nonstrict inequality makes this event slightly larger than the strict failure event and simplifies subsequent applications. -/ abbrev ReverseCountBarrierFailure (k : ℕ) (v : ℝ) (D : ℕ) (B : ℕ → Finset ℕ) (T : Finset ℕ) : Prop := ∃ ell ∈ range k, ((T ∩ B ell).card : ℝ) ≤ v * (ell + 1 : ℕ) - D /-- A single offset makes every finite family of linearly growing restricted counts satisfy the reverse barrier with probability at least `1 - err`. The subsets may overlap arbitrarily. -/ theorem exists_uniform_reverse_count_barrier {v mu err : ℝ} (hv : 0 < v) (hvm : v < mu) (herr : 0 < err) : ∃ D : ℕ, ∀ (P : Finset ℕ) (lam : ℝ), (∀ p ∈ P, p.Prime) → 0 < lam → ∀ (k : ℕ) (B : ℕ → Finset ℕ), (∀ ell < k, B ell ⊆ P) → (∀ ell < k, mu * (ell + 1 : ℕ) ≤ ∑ p ∈ B ell, primeTiltSelectionProbability lam p) → (∑ T ∈ P.powerset.filter (ReverseCountBarrierFailure k v D B), primeTiltWeight P lam T) ≤ err := by obtain ⟨theta, ht, hR1⟩ := exists_positive_chernoff_rate hv hvm let R : ℝ := exp (theta * v + mu * (exp (-theta) - 1)) have hR0 : 0 < R := exp_pos _ obtain ⟨D, hD⟩ := exists_geometric_tail_offset ht hR0 hR1 herr refine ⟨D, fun P lam hP hlam k B hB hmean ↦ ?_⟩ calc _ ≤ ∑ ell ∈ range k, ∑ T ∈ P.powerset.filter (fun T ↦ ((T ∩ B ell).card : ℝ) ≤ v * (ell + 1 : ℕ) - D), primeTiltWeight P lam T := finite_weighted_union_bound P.powerset (range k) (primeTiltWeight P lam) (fun T _ ↦ (primeTiltWeight_pos hP hlam T).le) _ _ ≤ ∑ ell ∈ range k, exp (-theta * (D : ℝ)) * R ^ (ell + 1) := by apply sum_le_sum intro ell hell exact primeTiltWeight_linear_barrier_failure_le hP (hB ell (mem_range.mp hell)) hlam v mu theta ht.le D ell (hmean ell (mem_range.mp hell)) _ = exp (-theta * (D : ℝ)) * ∑ ell ∈ range k, R ^ (ell + 1) := by rw [mul_sum] _ ≤ err := hD k end Erdos859Verification end /- Inlined development module: FiniteMarkDuplicates.lean -/ section /- Duplicate-mark bounds under the independent finite reference law. -/ open Finset namespace Erdos859Verification theorem finite_weighted_union_bound_general {α ι : Type*} (S : Finset α) (I : Finset ι) (w : α → ℝ) (hw : ∀ x ∈ S, 0 ≤ w x) (E : ι → α → Prop) [DecidableRel E] : (∑ x ∈ S, w x * (if ∃ i ∈ I, E i x then 1 else 0)) ≤ ∑ i ∈ I, ∑ x ∈ S, w x * (if E i x then 1 else 0) := by rw [sum_comm] apply sum_le_sum intro x hx have hnonneg (i : ι) : 0 ≤ w x * (if E i x then 1 else 0) := by split_ifs <;> simp_all by_cases he : ∃ i ∈ I, E i x · obtain ⟨i, hi, hix⟩ := he rw [if_pos ⟨i, hi, hix⟩, mul_one] calc _ = w x * (if E i x then 1 else 0) := by rw [if_pos hix, mul_one] _ ≤ _ := single_le_sum (fun j _ ↦ hnonneg j) hi · rw [if_neg he, mul_zero] exact sum_nonneg (fun i _ ↦ hnonneg i) theorem finite_product_equal_coordinates_le {ι α : Type*} [Fintype ι] [DecidableEq ι] [Fintype α] [DecidableEq α] (w : ι → α → ℝ) (i j : ι) (hij : i ≠ j) (a : ℝ) (hw : ∀ i y, 0 ≤ w i y) (hnorm : ∀ i, ∑ y, w i y = 1) (hatom : ∀ y, w i y ≤ a) : (∑ x : ι → α, finiteProductWeight w x * (if x i = x j then 1 else 0)) ≤ a := by apply finite_product_section_bound w (fun x ↦ if x i = x j then 1 else 0) i a hw hnorm intro z have hji : j ≠ i := Ne.symm hij simpa [Equiv.piSplitAt_symm_apply, hji] using hatom (z ⟨j, hji⟩) /-- A quadratic bound is sufficient for the regular-count event; it avoids any conditioning on distinctness during the concentration calculation. -/ theorem finite_iid_duplicate_probability_le {α : Type*} [Fintype α] [DecidableEq α] (n : ℕ) (w : α → ℝ) {a : ℝ} (ha : 0 ≤ a) (hw : ∀ y, 0 ≤ w y) (hnorm : ∑ y, w y = 1) (hatom : ∀ y, w y ≤ a) : (∑ x : Fin n → α, finiteProductWeight (fun _ ↦ w) x * (if ∃ i j : Fin n, i ≠ j ∧ x i = x j then 1 else 0)) ≤ (n : ℝ) ^ 2 * a := by classical let I : Finset (Fin n × Fin n) := univ.filter (fun ij ↦ ij.1 ≠ ij.2) have hevent (x : Fin n → α) : (∃ i j : Fin n, i ≠ j ∧ x i = x j) ↔ ∃ ij ∈ I, x ij.1 = x ij.2 := by constructor · rintro ⟨i, j, hij, heq⟩ exact ⟨(i, j), by simp [I, hij], heq⟩ · rintro ⟨⟨i, j⟩, hij, heq⟩ exact ⟨i, j, (mem_filter.mp hij).2, heq⟩ simp_rw [hevent] calc _ ≤ ∑ ij ∈ I, ∑ x : Fin n → α, finiteProductWeight (fun _ ↦ w) x * (if x ij.1 = x ij.2 then 1 else 0) := finite_weighted_union_bound_general univ I (finiteProductWeight (fun _ ↦ w)) (fun x _ ↦ finiteProductWeight_nonneg (fun _ ↦ hw) x) _ _ ≤ ∑ _ij ∈ I, a := by apply sum_le_sum intro ij hij exact finite_product_equal_coordinates_le (fun _ ↦ w) ij.1 ij.2 (mem_filter.mp hij).2 a (fun _ ↦ hw) (fun _ ↦ hnorm) hatom _ ≤ ∑ _ij : Fin n × Fin n, a := sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun _ _ _ ↦ ha) _ = _ := by simp [pow_two] end Erdos859Verification end /- Inlined development module: LargePrimeDivisors.lean -/ section /- Large prime divisors and weighted divisibility collision bounds. -/ namespace Erdos859Verification open Finset Real theorem card_prime_set_le_log_div {P : Finset ℕ} {m : ℕ} {v : ℝ} (hm : 0 < m) (hv : 0 < v) (hP : ∀ p ∈ P, p.Prime) (hlog : ∀ p ∈ P, v ≤ log (p : ℝ)) (hdvd : ∀ p ∈ P, p ∣ m) : (P.card : ℝ) ≤ log (m : ℝ) / v := by have hprodpos : 0 < ∏ p ∈ P, p := prod_pos (fun p hp ↦ (hP p hp).pos) have hprodle : (∏ p ∈ P, p) ≤ m := Nat.le_of_dvd hm ((primeProduct_dvd_iff hP m).mpr hdvd) apply (le_div_iff₀ hv).mpr calc (P.card : ℝ) * v = ∑ _p ∈ P, v := by simp _ ≤ ∑ p ∈ P, log (p : ℝ) := sum_le_sum hlog _ = log ((∏ p ∈ P, p : ℕ) : ℝ) := by rw [Nat.cast_prod, Real.log_prod] intro p hp exact_mod_cast (hP p hp).ne_zero _ ≤ log (m : ℝ) := log_le_log (by exact_mod_cast hprodpos) (by exact_mod_cast hprodle) theorem card_large_prime_divisors_le {P : Finset ℕ} {m : ℕ} {v : ℝ} (hm : 0 < m) (hv : 0 < v) (hP : ∀ p ∈ P, p.Prime) (hlog : ∀ p ∈ P, v ≤ log (p : ℝ)) : ((P.filter (fun p ↦ p ∣ m)).card : ℝ) ≤ log (m : ℝ) / v := by apply card_prime_set_le_log_div hm hv · intro p hp exact hP p (mem_filter.mp hp).1 · intro p hp exact hlog p (mem_filter.mp hp).1 · intro p hp exact (mem_filter.mp hp).2 theorem primeLogMark_broad_dvd_upper {v eps : ℝ} {m : ℕ} (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) (hm : 0 < m) : (∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter (fun p ↦ p ∣ m), primeLogMarkWeight v ((1 + eps) * v) p) ≤ (4 * exp (-v) / eps) * (log (m : ℝ) / v) := by classical have hv0 : 0 < v := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv have hcard := card_large_prime_divisors_le (P := primeLogWindow v ((1 + eps) * v)) hm hv0 (fun _ hp ↦ (mem_primeLogWindow.mp hp).1) (fun _ hp ↦ (mem_primeLogWindow.mp hp).2.1.le) calc _ ≤ ∑ _p ∈ (primeLogWindow v ((1 + eps) * v)).filter (fun p ↦ p ∣ m), 4 * exp (-v) / eps := by apply sum_le_sum intro p hp exact primeLogMark_broad_atom_upper hv heps heps1 hlarge (mem_filter.mp hp).1 _ = (4 * exp (-v) / eps) * (((primeLogWindow v ((1 + eps) * v)).filter (fun p ↦ p ∣ m)).card : ℝ) := by simp [mul_comm] _ ≤ _ := mul_le_mul_of_nonneg_left hcard (by positivity) theorem finite_nat_weighted_union_bound (S I : Finset ℕ) (w : ℕ → ℝ) (hw : ∀ p ∈ S, 0 ≤ w p) (F : ℕ → ℕ → Prop) [DecidableRel F] : (∑ p ∈ S.filter (fun p ↦ ∃ d ∈ I, F d p), w p) ≤ ∑ d ∈ I, ∑ p ∈ S.filter (F d), w p := by simp only [sum_filter] rw [sum_comm] apply sum_le_sum intro p hp have hnonneg (d : ℕ) : 0 ≤ if F d p then w p else 0 := by split_ifs · exact hw p hp · exact le_rfl split_ifs with h · obtain ⟨d, hd, hF⟩ := h calc w p = if F d p then w p else 0 := by rw [if_pos hF] _ ≤ ∑ d ∈ I, if F d p then w p else 0 := single_le_sum (fun d _ ↦ hnonneg d) hd · exact sum_nonneg (fun d _ ↦ hnonneg d) theorem primeLogMark_broad_dvd_any_upper (D : Finset ℕ) {v eps : ℝ} (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) (hD : ∀ d ∈ D, 0 < d) : (∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter (fun p ↦ ∃ d ∈ D, p ∣ d), primeLogMarkWeight v ((1 + eps) * v) p) ≤ (4 * exp (-v) / eps / v) * ∑ d ∈ D, log (d : ℝ) := by classical have hmass := primeLogWindowMass_broad_lower hv heps heps1 hlarge have hmasspos : 0 < primeLogWindowMass v ((1 + eps) * v) := (by positivity : 0 < eps / 4).trans_le hmass calc _ ≤ ∑ d ∈ D, ∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter (fun p ↦ p ∣ d), primeLogMarkWeight v ((1 + eps) * v) p := finite_nat_weighted_union_bound _ D _ (fun _ _ ↦ by unfold primeLogMarkWeight; positivity) _ _ ≤ ∑ d ∈ D, (4 * exp (-v) / eps) * (log (d : ℝ) / v) := by apply sum_le_sum intro d hd exact primeLogMark_broad_dvd_upper hv heps heps1 hlarge (hD d hd) _ = _ := by rw [mul_sum]; apply sum_congr rfl; intro d _; ring theorem primeLogMark_broad_dvd_any_card_upper (D : Finset ℕ) {v eps : ℝ} {T : ℕ} (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) (hD : ∀ d ∈ D, 0 < d ∧ d ≤ T) : (∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter (fun p ↦ ∃ d ∈ D, p ∣ d), primeLogMarkWeight v ((1 + eps) * v) p) ≤ (4 * exp (-v) / eps / v) * (D.card : ℝ) * log (T : ℝ) := by have hv0 : 0 < v := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv calc _ ≤ (4 * exp (-v) / eps / v) * ∑ d ∈ D, log (d : ℝ) := primeLogMark_broad_dvd_any_upper D hv heps heps1 hlarge (fun d hd ↦ (hD d hd).1) _ ≤ (4 * exp (-v) / eps / v) * ∑ _d ∈ D, log (T : ℝ) := by apply mul_le_mul_of_nonneg_left _ (by positivity) apply sum_le_sum intro d hd exact log_le_log (by exact_mod_cast (hD d hd).1) (by exact_mod_cast (hD d hd).2) _ = _ := by simp [mul_assoc] end Erdos859Verification end /- Inlined development module: PrimeCountVariance.lean -/ section /- Exact first and second count moments for the finite tilted prime law. -/ open Finset Real namespace Erdos859Verification theorem primeTiltWeight_singleton_selected {p : ℕ} (hp : p.Prime) {lam : ℝ} (hlam : 0 < lam) : primeTiltWeight {p} lam {p} = primeTiltSelectionProbability lam p := by have hp0 : (p : ℝ) ≠ 0 := by exact_mod_cast hp.ne_zero have hp1 : (1 : ℝ) < p := by exact_mod_cast hp.one_lt have hd : (p : ℝ) + lam - 1 ≠ 0 := by linarith have hden : 1 + (lam - 1) / (p : ℝ) = ((p : ℝ) + lam - 1) / p := by field_simp ring simp only [primeTiltWeight, primePatternWeight, primeTiltNormalizer, prod_singleton, mem_singleton, ite_true, card_singleton, pow_one, hden, primeTiltSelectionProbability] field_simp [hp0, hd] theorem primeTiltWeight_singleton_unselected {p : ℕ} (hp : p.Prime) {lam : ℝ} (hlam : 0 < lam) : primeTiltWeight {p} lam ∅ = 1 - primeTiltSelectionProbability lam p := by have hs := sum_primeTiltWeight (P := {p}) (fun q hq ↦ by simpa only [mem_singleton.mp hq] using hp) hlam have hsum : primeTiltWeight {p} lam ∅ + primeTiltWeight {p} lam {p} = 1 := by change (∑ T ∈ (insert p (∅ : Finset ℕ)).powerset, primeTiltWeight {p} lam T) = 1 at hs rw [sum_powerset_insert (by simp : p ∉ (∅ : Finset ℕ))] at hs simpa using hs rw [primeTiltWeight_singleton_selected hp hlam] at hsum linarith /-- Adjoining one prime gives the exact Bernoulli recursion for every observable that depends on the number of selected primes. -/ theorem prime_tilt_card_observable_insert {P : Finset ℕ} {p : ℕ} (hpP : p ∉ P) (hp : p.Prime) {lam : ℝ} (hlam : 0 < lam) (G : ℕ → ℝ) : (∑ T ∈ (insert p P).powerset, primeTiltWeight (insert p P) lam T * G T.card) = (1 - primeTiltSelectionProbability lam p) * (∑ T ∈ P.powerset, primeTiltWeight P lam T * G T.card) + primeTiltSelectionProbability lam p * (∑ T ∈ P.powerset, primeTiltWeight P lam T * G (T.card + 1)) := by rw [sum_powerset_insert hpP, mul_sum, mul_sum] congr 1 · apply sum_congr rfl intro T hT have hTP : T ⊆ P := mem_powerset.mp hT have hw := primeTiltWeight_split_universe (subset_insert p P) T lam simp only [insert_sdiff_cancel hpP, inter_eq_left.mpr hTP, sdiff_eq_empty_iff_subset.mpr hTP] at hw rw [hw, primeTiltWeight_singleton_unselected hp hlam] ring · apply sum_congr rfl intro T hT have hTP : T ⊆ P := mem_powerset.mp hT have hpT : p ∉ T := fun h ↦ hpP (hTP h) have hw := primeTiltWeight_split_universe (subset_insert p P) (insert p T) lam simp only [insert_sdiff_cancel hpP, insert_inter_of_notMem hpP, inter_eq_left.mpr hTP, insert_sdiff_of_notMem T hpP, sdiff_eq_empty_iff_subset.mpr hTP, insert_empty_eq] at hw rw [hw, primeTiltWeight_singleton_selected hp hlam, card_insert_of_notMem hpT] ring theorem primeTiltWeight_count_add_one_mean {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * ((T.card + 1 : ℕ) : ℝ)) = (∑ T ∈ P.powerset, primeTiltWeight P lam T * (T.card : ℝ)) + 1 := by simp only [Nat.cast_add, Nat.cast_one, mul_add, mul_one, sum_add_distrib, sum_primeTiltWeight hP hlam] theorem primeTiltWeight_count_add_one_second_moment {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * ((T.card + 1 : ℕ) : ℝ) ^ 2) = (∑ T ∈ P.powerset, primeTiltWeight P lam T * (T.card : ℝ) ^ 2) + 2 * (∑ T ∈ P.powerset, primeTiltWeight P lam T * (T.card : ℝ)) + 1 := by calc _ = ∑ T ∈ P.powerset, ((primeTiltWeight P lam T * (T.card : ℝ) ^ 2) + 2 * (primeTiltWeight P lam T * (T.card : ℝ)) + primeTiltWeight P lam T) := by apply sum_congr rfl intro T _ push_cast ring _ = _ := by rw [sum_add_distrib, sum_add_distrib, ← mul_sum, sum_primeTiltWeight hP hlam] /-- The first moment is the sum of the effective prime probabilities, and the second moment is its square plus the sum of the Bernoulli variances. -/ theorem primeTiltWeight_count_first_second_moment {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * (T.card : ℝ)) = (∑ p ∈ P, primeTiltSelectionProbability lam p) ∧ (∑ T ∈ P.powerset, primeTiltWeight P lam T * (T.card : ℝ) ^ 2) = (∑ p ∈ P, primeTiltSelectionProbability lam p) ^ 2 + ∑ p ∈ P, primeTiltSelectionProbability lam p * (1 - primeTiltSelectionProbability lam p) := by revert hP induction P using Finset.induction_on with | empty => intro _ simp | @insert p P hpP ih => intro hP have hp : p.Prime := hP p (mem_insert_self p P) have hPrest : ∀ q ∈ P, q.Prime := fun q hq ↦ hP q (mem_insert_of_mem hq) obtain ⟨ih1, ih2⟩ := ih hPrest constructor · rw [prime_tilt_card_observable_insert hpP hp hlam (fun n ↦ (n : ℝ)), primeTiltWeight_count_add_one_mean hPrest hlam, ih1, sum_insert hpP] ring · rw [prime_tilt_card_observable_insert hpP hp hlam (fun n ↦ (n : ℝ) ^ 2), primeTiltWeight_count_add_one_second_moment hPrest hlam, ih1, ih2, sum_insert hpP, sum_insert hpP] ring theorem primeTiltWeight_count_mean {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * (T.card : ℝ)) = ∑ p ∈ P, primeTiltSelectionProbability lam p := (primeTiltWeight_count_first_second_moment hP hlam).1 theorem primeTiltWeight_count_second_moment_le {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * (T.card : ℝ) ^ 2) ≤ (∑ p ∈ P, primeTiltSelectionProbability lam p) ^ 2 + ∑ p ∈ P, primeTiltSelectionProbability lam p := by rw [(primeTiltWeight_count_first_second_moment hP hlam).2] apply add_le_add le_rfl apply sum_le_sum intro p hp have hq := (primeTiltSelectionProbability_pos_lt_one (hP p hp) hlam).1.le nlinarith [sq_nonneg (primeTiltSelectionProbability lam p)] theorem primeTiltWeight_restricted_count_mean {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) {lam : ℝ} (hlam : 0 < lam) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * ((T ∩ B).card : ℝ)) = ∑ p ∈ B, primeTiltSelectionProbability lam p := by rw [prime_tilt_expectation_restrict hP hB hlam (fun U ↦ (U.card : ℝ))] exact primeTiltWeight_count_mean (fun p hp ↦ hP p (hB hp)) hlam theorem primeTiltWeight_restricted_count_second_moment_le {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) {lam : ℝ} (hlam : 0 < lam) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * ((T ∩ B).card : ℝ) ^ 2) ≤ (∑ p ∈ B, primeTiltSelectionProbability lam p) ^ 2 + ∑ p ∈ B, primeTiltSelectionProbability lam p := by rw [prime_tilt_expectation_restrict hP hB hlam (fun U ↦ (U.card : ℝ) ^ 2)] exact primeTiltWeight_count_second_moment_le (fun p hp ↦ hP p (hB hp)) hlam end Erdos859Verification end /- Inlined development module: FiniteBitCollision.lean -/ section /- Exact fair-bit agreement probabilities for finite collision arguments. -/ open Finset namespace Erdos859Verification noncomputable def fairBitWeight (ι : Type*) [Fintype ι] : ℝ := 1 / (2 : ℝ) ^ Fintype.card ι noncomputable def fairBitPairMean {ι : Type*} [Fintype ι] [DecidableEq ι] (F : (ι → Bool) → (ι → Bool) → ℝ) : ℝ := ∑ b, ∑ b', fairBitWeight ι * fairBitWeight ι * F b b' theorem fairBitWeight_nonneg (ι : Type*) [Fintype ι] : 0 ≤ fairBitWeight ι := by unfold fairBitWeight positivity theorem fairBitWeight_eq_prod (ι : Type*) [Fintype ι] : fairBitWeight ι = ∏ _i : ι, (1 / 2 : ℝ) := by simp [fairBitWeight] theorem sum_fairBitWeight (ι : Type*) [Fintype ι] [DecidableEq ι] : (∑ _b : ι → Bool, fairBitWeight ι) = 1 := by have hnorm : ∀ _i : ι, ∑ _b : Bool, (1 / 2 : ℝ) = 1 := by intro i norm_num simpa only [finiteProductWeight, ← fairBitWeight_eq_prod] using sum_finiteProductWeight (fun (_i : ι) (_b : Bool) ↦ (1 / 2 : ℝ)) hnorm /-- For a fixed bit vector, agreement on a finite set has probability the reciprocal of two raised to the number of constrained coordinates. -/ theorem fairBit_agreement_probability {ι : Type*} [Fintype ι] [DecidableEq ι] (B : Finset ι) (b : ι → Bool) : (∑ b' : ι → Bool, fairBitWeight ι * (if ∀ i ∈ B, b i = b' i then 1 else 0)) = 1 / (2 : ℝ) ^ B.card := by classical rw [fairBitWeight_eq_prod] simp_rw [← Fintype.prod_boole, ← prod_mul_distrib] rw [← Fintype.prod_sum (fun (i : ι) (u : Bool) ↦ (1 / 2 : ℝ) * (if i ∈ B → b i = u then 1 else 0))] have hsum : ∀ i : ι, (∑ u : Bool, (1 / 2 : ℝ) * (if i ∈ B → b i = u then 1 else 0)) = if i ∈ B then (1 / 2 : ℝ) else 1 := by intro i by_cases hi : i ∈ B · cases b i <;> simp [hi] · simp [hi] simp_rw [hsum] rw [Fintype.prod_ite_mem] simp /-- The exact probability that two independent fair bit vectors agree on `B`. -/ theorem fairBitPair_agreement_probability {ι : Type*} [Fintype ι] [DecidableEq ι] (B : Finset ι) : fairBitPairMean (fun b b' ↦ if ∀ i ∈ B, b i = b' i then 1 else 0) = 1 / (2 : ℝ) ^ B.card := by classical unfold fairBitPairMean calc _ = ∑ b : ι → Bool, fairBitWeight ι * (∑ b' : ι → Bool, fairBitWeight ι * (if ∀ i ∈ B, b i = b' i then 1 else 0)) := by apply sum_congr rfl intro b _ rw [mul_sum] apply sum_congr rfl intro b' _ ring _ = ∑ _b : ι → Bool, fairBitWeight ι * (1 / (2 : ℝ) ^ B.card) := by simp_rw [fairBit_agreement_probability] _ = _ := by rw [← sum_mul, sum_fairBitWeight, one_mul] theorem fairBitPair_equality_probability {ι : Type*} [Fintype ι] [DecidableEq ι] : fairBitPairMean (fun b b' : ι → Bool ↦ if b = b' then 1 else 0) = 1 / (2 : ℝ) ^ Fintype.card ι := by simpa only [mem_univ, forall_true_left, funext_iff, card_univ] using fairBitPair_agreement_probability (univ : Finset ι) theorem fairBitPairMean_eq_sum_div {ι : Type*} [Fintype ι] [DecidableEq ι] (F : (ι → Bool) → (ι → Bool) → ℝ) : fairBitPairMean F = (∑ p : (ι → Bool) × (ι → Bool), F p.1 p.2) / (4 : ℝ) ^ Fintype.card ι := by have hw : fairBitWeight ι * fairBitWeight ι = 1 / (4 : ℝ) ^ Fintype.card ι := by unfold fairBitWeight rw [div_mul_div_comm, ← mul_pow] norm_num simp only [fairBitPairMean, hw, Fintype.sum_prod_type, sum_div, one_div_mul_eq_div] /-- An explicit normalized cardinality version of the agreement probability. -/ theorem fairBitPair_agreement_card_ratio {ι : Type*} [Fintype ι] [DecidableEq ι] (B : Finset ι) : (((univ : Finset ((ι → Bool) × (ι → Bool))).filter (fun p ↦ ∀ i ∈ B, p.1 i = p.2 i)).card : ℝ) / (4 : ℝ) ^ Fintype.card ι = 1 / (2 : ℝ) ^ B.card := by classical simpa only [fairBitPairMean_eq_sum_div, sum_boole] using fairBitPair_agreement_probability B theorem fairBitPairMean_mono {ι : Type*} [Fintype ι] [DecidableEq ι] {F G : (ι → Bool) → (ι → Bool) → ℝ} (h : ∀ b b', F b b' ≤ G b b') : fairBitPairMean F ≤ fairBitPairMean G := by apply sum_le_sum intro b _ apply sum_le_sum intro b' _ exact mul_le_mul_of_nonneg_left (h b b') (mul_nonneg (fairBitWeight_nonneg ι) (fairBitWeight_nonneg ι)) theorem fairBitPairMean_add {ι : Type*} [Fintype ι] [DecidableEq ι] (F G : (ι → Bool) → (ι → Bool) → ℝ) : fairBitPairMean (fun b b' ↦ F b b' + G b b') = fairBitPairMean F + fairBitPairMean G := by simp only [fairBitPairMean, mul_add, sum_add_distrib] theorem fairBitPairMean_const_mul {ι : Type*} [Fintype ι] [DecidableEq ι] (F : (ι → Bool) → (ι → Bool) → ℝ) (c : ℝ) : fairBitPairMean (fun b b' ↦ c * F b b') = c * fairBitPairMean F := by unfold fairBitPairMean simp_rw [← mul_assoc, mul_comm (fairBitWeight ι * fairBitWeight ι) c, mul_assoc] simp only [← mul_sum] theorem fairBitPairMean_sum {ι κ : Type*} [Fintype ι] [DecidableEq ι] [Fintype κ] (F : κ → (ι → Bool) → (ι → Bool) → ℝ) : fairBitPairMean (fun b b' ↦ ∑ j, F j b b') = ∑ j, fairBitPairMean (F j) := by unfold fairBitPairMean simp only [mul_sum] calc _ = ∑ b, ∑ j, ∑ b', fairBitWeight ι * fairBitWeight ι * F j b b' := by apply sum_congr rfl intro b _ exact sum_comm _ = _ := sum_comm /-- A cover by agreement events bounds the mean of an arbitrary cost. Only the covering costs must be nonnegative. -/ theorem fairBitPair_cover_bound {ι κ : Type*} [Fintype ι] [DecidableEq ι] [Fintype κ] (F : (ι → Bool) → (ι → Bool) → ℝ) (B : κ → Finset ι) (c : κ → ℝ) (d : ℝ) (hc : ∀ j, 0 ≤ c j) (hdiag : ∀ b, F b b ≤ d) (hcover : ∀ b b', b ≠ b' → ∃ j, (∀ i ∈ B j, b i = b' i) ∧ F b b' ≤ c j) : fairBitPairMean F ≤ d / (2 : ℝ) ^ Fintype.card ι + ∑ j, c j / (2 : ℝ) ^ (B j).card := by classical have hind : ∀ (b b' : ι → Bool) j, 0 ≤ c j * (if ∀ i ∈ B j, b i = b' i then (1 : ℝ) else 0) := by intro b b' j split_ifs <;> simp [hc j] have hpoint : ∀ b b', F b b' ≤ d * (if b = b' then 1 else 0) + ∑ j, c j * (if ∀ i ∈ B j, b i = b' i then 1 else 0) := by intro b b' by_cases heq : b = b' · subst b' rw [if_pos rfl, mul_one] exact (hdiag b).trans (le_add_of_nonneg_right (sum_nonneg (fun j _ ↦ hind b b j))) · obtain ⟨j, hj, hF⟩ := hcover b b' heq simp only [if_neg heq, mul_zero, zero_add] calc F b b' ≤ c j := hF _ = c j * (if ∀ i ∈ B j, b i = b' i then 1 else 0) := by rw [if_pos hj, mul_one] _ ≤ _ := single_le_sum (fun k _ ↦ hind b b' k) (mem_univ j) calc fairBitPairMean F ≤ fairBitPairMean (fun b b' ↦ d * (if b = b' then 1 else 0) + ∑ j, c j * (if ∀ i ∈ B j, b i = b' i then 1 else 0)) := fairBitPairMean_mono hpoint _ = _ := by rw [fairBitPairMean_add, fairBitPairMean_const_mul, fairBitPair_equality_probability, fairBitPairMean_sum] simp_rw [fairBitPairMean_const_mul, fairBitPair_agreement_probability] simp only [mul_one_div] /-- Classifying unequal bit vectors by their highest differing band gives the reciprocal-power collision bound. -/ theorem fairBitPair_highest_band_bound {ι κ : Type*} [Fintype ι] [DecidableEq ι] [Fintype κ] [LinearOrder κ] (band : ι → κ) (F : (ι → Bool) → (ι → Bool) → ℝ) (c : κ → ℝ) (d : ℝ) (hc : ∀ j, 0 ≤ c j) (hdiag : ∀ b, F b b ≤ d) (hhighest : ∀ b b' j, (∃ i, band i = j ∧ b i ≠ b' i) → (∀ i, j < band i → b i = b' i) → F b b' ≤ c j) : fairBitPairMean F ≤ d / (2 : ℝ) ^ Fintype.card ι + ∑ j, c j / (2 : ℝ) ^ (univ.filter (fun i ↦ j < band i)).card := by classical apply fairBitPair_cover_bound F (fun j ↦ univ.filter (fun i ↦ j < band i)) c d hc hdiag intro b b' hne let D : Finset ι := univ.filter (fun i ↦ b i ≠ b' i) obtain ⟨i, hi⟩ := Function.ne_iff.mp hne have hD : D.Nonempty := ⟨i, by simpa [D] using hi⟩ obtain ⟨m, hm, hmax⟩ := D.exists_max_image band hD have hdiff : b m ≠ b' m := (mem_filter.mp hm).2 have hagree : ∀ i, band m < band i → b i = b' i := by intro i hmi by_contra hdiffi have hiD : i ∈ D := by simp [D, hdiffi] exact (not_lt_of_ge (hmax i hiD)) hmi refine ⟨band m, ?_, hhighest b b' (band m) ⟨m, rfl, hdiff⟩ hagree⟩ intro i hi exact hagree i (mem_filter.mp hi).2 def fairBitDifference (b b' : Bool) : ℝ := (if b then 1 else 0) - (if b' then 1 else 0) theorem fairBitDifference_self (b : Bool) : fairBitDifference b b = 0 := by simp only [fairBitDifference, sub_self] theorem fairBitDifference_sign {b b' : Bool} (hne : b ≠ b') : fairBitDifference b b' = 1 ∨ fairBitDifference b b' = -1 := by cases b <;> cases b' <;> simp_all [fairBitDifference] /-- The averaged finite subset-sum collision bound. Each coordinate is an independent finite mark; its band determines its small-ball bound. -/ theorem finite_mark_subsetSum_collision_bound {ι κ : Type*} [Fintype ι] [DecidableEq ι] [Fintype κ] [LinearOrder κ] {α : ι → Type*} [∀ i, Fintype (α i)] (band : ι → κ) (w mark : ∀ i, α i → ℝ) (c : κ → ℝ) (h : ℝ) (hw : ∀ i y, 0 ≤ w i y) (hnorm : ∀ i, ∑ y, w i y = 1) (hc : ∀ j, 0 ≤ c j) (hh : 0 ≤ h) (hsmall : ∀ i u, ∑ y, w i y * (if |mark i y - u| ≤ h then 1 else 0) ≤ c (band i)) : fairBitPairMean (fun b b' ↦ ∑ x : ∀ i, α i, finiteProductWeight w x * (if |∑ i, fairBitDifference (b i) (b' i) * mark i (x i)| ≤ h then 1 else 0)) ≤ 1 / (2 : ℝ) ^ Fintype.card ι + ∑ j, c j / (2 : ℝ) ^ (univ.filter (fun i ↦ j < band i)).card := by classical apply fairBitPair_highest_band_bound band _ c 1 hc · intro b simp only [fairBitDifference_self, zero_mul, sum_const_zero, abs_zero, if_pos hh, mul_one] exact (sum_finiteProductWeight w hnorm).le · intro b b' j hdiff _hagree obtain ⟨i, hi, hne⟩ := hdiff have hbound := finite_product_sum_smallBall w mark (fun k ↦ fairBitDifference (b k) (b' k)) i h (c (band i)) 0 hw hnorm (fairBitDifference_sign hne) (hsmall i) simpa only [sub_zero, hi] using hbound end Erdos859Verification end /- Inlined development module: PrimeConditionalOdds.lean -/ section /- Fixed-cardinality tilted selections have exact reciprocal-odds weights. -/ open Finset Real namespace Erdos859Verification noncomputable def primeOddsWeight (T : Finset ℕ) : ℝ := ∏ p ∈ T, 1 / ((p : ℝ) - 1) theorem primePatternWeight_eq_empty_mul_odds {P T : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hT : T ⊆ P) : primePatternWeight P T = primePatternWeight P ∅ * primeOddsWeight T := by classical have hfilter : P.filter (fun p ↦ p ∈ T) = T := by ext p simp only [mem_filter] exact and_iff_right_of_imp (fun hp ↦ hT hp) have hprod : (∏ p ∈ P, if p ∈ T then 1 / ((p : ℝ) - 1) else 1) = primeOddsWeight T := by rw [prod_ite] simp only [hfilter, prod_const_one, mul_one, primeOddsWeight] rw [← hprod] unfold primePatternWeight simp only [Finset.notMem_empty, if_false] rw [← prod_mul_distrib] apply prod_congr rfl intro p hp have hp0 : (p : ℝ) ≠ 0 := by exact_mod_cast (hP p hp).ne_zero have hp1 : (p : ℝ) - 1 ≠ 0 := by have h := (hP p hp).one_lt exact sub_ne_zero.mpr (by exact_mod_cast Nat.ne_of_gt h) by_cases hpt : p ∈ T · simp only [if_pos hpt] field_simp · simp only [if_neg hpt, mul_one] theorem primeTiltWeight_fixedCard_factorization {P T : Finset ℕ} {n : ℕ} (hP : ∀ p ∈ P, p.Prime) (hT : T ⊆ P) (hcard : T.card = n) (lam : ℝ) : primeTiltWeight P lam T = (primePatternWeight P ∅ * lam ^ n / primeTiltNormalizer P lam) * primeOddsWeight T := by rw [primeTiltWeight, primePatternWeight_eq_empty_mul_odds hP hT, hcard] ring /-- Conditioning on the number of selected primes removes the tilt parameter exactly. No iid assertion is made about the conditioned law. -/ theorem primeTilt_fixedCard_expectation_eq_odds {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (n : ℕ) (F : Finset ℕ → ℝ) : (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T * F T) / (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T) = (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeOddsWeight T * F T) / (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeOddsWeight T) := by classical let K := primePatternWeight P ∅ * lam ^ n / primeTiltNormalizer P lam have hK : 0 < K := div_pos (mul_pos (primePatternWeight_pos hP ∅) (pow_pos hlam n)) (primeTiltNormalizer_pos hP hlam) have hw : ∀ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T = K * primeOddsWeight T := by intro T hT exact primeTiltWeight_fixedCard_factorization hP (mem_powerset.mp (mem_filter.mp hT).1) (mem_filter.mp hT).2 lam have hnum : (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T * F T) = K * (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeOddsWeight T * F T) := by rw [mul_sum] apply sum_congr rfl intro T hT rw [hw T hT, mul_assoc] have hden : (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T) = K * (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeOddsWeight T) := by rw [mul_sum] exact sum_congr rfl hw rw [hnum, hden, mul_div_mul_left _ _ hK.ne'] theorem log_prime_odds_ratio_le {p : ℕ} (hp : p.Prime) : log ((p : ℝ) / ((p : ℝ) - 1)) ≤ 2 / (p : ℝ) := by have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le have hp0 : (0 : ℝ) < p := by linarith have hd : 0 < (p : ℝ) - 1 := by linarith have h := log_le_sub_one_of_pos (div_pos hp0 hd) have heq : (p : ℝ) / ((p : ℝ) - 1) - 1 = 1 / ((p : ℝ) - 1) := by field_simp; ring rw [heq] at h exact h.trans ((div_le_div_iff₀ hd hp0).mpr (by linarith)) /-- The density ratio between reciprocal odds and reciprocal weights is close to one when all selected primes are large. -/ theorem prime_odds_ratio_bounds {T : Finset ℕ} {a : ℝ} (hT : ∀ p ∈ T, p.Prime) (hlarge : ∀ p ∈ T, a ≤ log (p : ℝ)) : 1 ≤ (∏ p ∈ T, (p : ℝ) / ((p : ℝ) - 1)) ∧ (∏ p ∈ T, (p : ℝ) / ((p : ℝ) - 1)) ≤ exp (2 * (T.card : ℝ) * exp (-a)) := by have hp0 (p : ℕ) (hp : p ∈ T) : (0 : ℝ) < p := by exact_mod_cast (hT p hp).pos have hd (p : ℕ) (hp : p ∈ T) : 0 < (p : ℝ) - 1 := by have h : (1 : ℝ) < p := by exact_mod_cast (hT p hp).one_lt linarith refine ⟨one_le_prod (fun p hp ↦ (one_le_div (hd p hp)).mpr (by linarith)), ?_⟩ apply (log_le_iff_le_exp (prod_pos fun p hp ↦ div_pos (hp0 p hp) (hd p hp))).mp rw [log_prod (fun p hp ↦ (div_pos (hp0 p hp) (hd p hp)).ne')] calc _ ≤ ∑ _p ∈ T, 2 * exp (-a) := by apply sum_le_sum intro p hp have hrecip : 1 / (p : ℝ) ≤ exp (-a) := by rw [exp_neg, ← one_div] exact one_div_le_one_div_of_le (exp_pos a) ((le_log_iff_exp_le (hp0 p hp)).mp (hlarge p hp)) calc _ ≤ 2 / (p : ℝ) := log_prime_odds_ratio_le (hT p hp) _ = 2 * (1 / (p : ℝ)) := by ring _ ≤ _ := mul_le_mul_of_nonneg_left hrecip (by norm_num) _ = _ := by simp; ring end Erdos859Verification end /- Inlined development module: PrimeCountRegularity.lean -/ section /- Uniform quadratic count regularity for finite tilted prime bands. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification /-- The count statistic controlling collisions and reweighting errors in geometrically separated prime bands. -/ noncomputable def primeCountRegularity (A : ℝ) (k : ℕ) (B : ℕ → Finset ℕ) (T : Finset ℕ) : ℝ := ∑ j ∈ range k, ((T ∩ B j).card : ℝ) ^ 2 * exp (-A * (2 : ℝ) ^ j) theorem primeCountRegularity_nonneg (A : ℝ) (k : ℕ) (B : ℕ → Finset ℕ) (T : Finset ℕ) : 0 ≤ primeCountRegularity A k B T := by apply sum_nonneg intro j _ exact mul_nonneg (sq_nonneg _) (exp_pos _).le /-- The rapidly decreasing dyadic weights are dominated by a geometric series starting with `exp(-A)`. -/ theorem sum_dyadic_exp_decay_le {A : ℝ} (hA : 0 < A) (k : ℕ) : (∑ j ∈ range k, exp (-A * (2 : ℝ) ^ j)) ≤ exp (-A) / (1 - exp (-A)) := by have hq0 : 0 ≤ exp (-A) := (exp_pos _).le have hq1 : exp (-A) < 1 := exp_lt_one_iff.mpr (neg_neg_of_pos hA) have hgeom : (∑ j ∈ range k, exp (-A) ^ j) ≤ 1 / (1 - exp (-A)) := by simpa using geom_sum_Ico_le_of_lt_one (m := 0) (n := k) hq0 hq1 calc _ ≤ ∑ j ∈ range k, exp (-A * ((j + 1 : ℕ) : ℝ)) := by apply sum_le_sum intro j _ apply exp_le_exp.mpr apply mul_le_mul_of_nonpos_left _ (neg_nonpos.mpr hA.le) exact_mod_cast Nat.succ_le_of_lt (Nat.lt_two_pow_self (n := j)) _ = exp (-A) * ∑ j ∈ range k, exp (-A) ^ j := by rw [mul_sum] apply sum_congr rfl intro j _ rw [mul_comm (-A), exp_nat_mul, pow_succ, mul_comm] _ ≤ exp (-A) * (1 / (1 - exp (-A))) := mul_le_mul_of_nonneg_left hgeom hq0 _ = _ := by ring /-- Uniformly bounded band means give a uniformly bounded expected regularity statistic, regardless of how many bands are present. -/ theorem primeCountRegularity_expectation_le {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam A M : ℝ} (hlam : 0 < lam) (hA : 0 < A) (hM : 0 ≤ M) (k : ℕ) (B : ℕ → Finset ℕ) (hB : ∀ j < k, B j ⊆ P) (hmean : ∀ j < k, (∑ p ∈ B j, primeTiltSelectionProbability lam p) ≤ M) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * primeCountRegularity A k B T) ≤ (M ^ 2 + M) * exp (-A) / (1 - exp (-A)) := by have hmoment (j : ℕ) (hj : j < k) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * ((T ∩ B j).card : ℝ) ^ 2) ≤ M ^ 2 + M := by have hmu0 : 0 ≤ ∑ p ∈ B j, primeTiltSelectionProbability lam p := by apply sum_nonneg intro p hp exact (primeTiltSelectionProbability_pos_lt_one (hP p (hB j hj hp)) hlam).1.le exact (primeTiltWeight_restricted_count_second_moment_le hP (hB j hj) hlam).trans (add_le_add (pow_le_pow_left₀ hmu0 (hmean j hj) 2) (hmean j hj)) unfold primeCountRegularity simp only [mul_sum] rw [sum_comm] calc _ = ∑ j ∈ range k, (∑ T ∈ P.powerset, primeTiltWeight P lam T * ((T ∩ B j).card : ℝ) ^ 2) * exp (-A * (2 : ℝ) ^ j) := by apply sum_congr rfl intro j _ rw [sum_mul] apply sum_congr rfl intro T _ ring _ ≤ ∑ j ∈ range k, (M ^ 2 + M) * exp (-A * (2 : ℝ) ^ j) := by apply sum_le_sum intro j hj exact mul_le_mul_of_nonneg_right (hmoment j (Finset.mem_range.mp hj)) (exp_pos _).le _ = (M ^ 2 + M) * ∑ j ∈ range k, exp (-A * (2 : ℝ) ^ j) := by rw [mul_sum] _ ≤ (M ^ 2 + M) * (exp (-A) / (1 - exp (-A))) := mul_le_mul_of_nonneg_left (sum_dyadic_exp_decay_le hA k) (add_nonneg (sq_nonneg M) hM) _ = _ := by ring /-- Markov's inequality turns the expected quadratic statistic into an explicit bound on the bad count event. -/ theorem primeCountRegularity_bad_weight_le {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam A M r0 : ℝ} (hlam : 0 < lam) (hA : 0 < A) (hM : 0 ≤ M) (hr0 : 0 < r0) (k : ℕ) (B : ℕ → Finset ℕ) (hB : ∀ j < k, B j ⊆ P) (hmean : ∀ j < k, (∑ p ∈ B j, primeTiltSelectionProbability lam p) ≤ M) : (∑ T ∈ P.powerset with r0 ≤ primeCountRegularity A k B T, primeTiltWeight P lam T) ≤ ((M ^ 2 + M) * exp (-A) / (1 - exp (-A))) / r0 := by exact (finite_weighted_markov P.powerset (primeTiltWeight P lam) (primeCountRegularity A k B) hr0 (fun T _ ↦ (primeTiltWeight_pos hP hlam T).le) (fun T _ ↦ primeCountRegularity_nonneg A k B T)).trans (div_le_div_of_nonneg_right (primeCountRegularity_expectation_le hP hlam hA hM k B hB hmean) hr0.le) theorem tendsto_primeCountRegularity_bound_zero (M r0 : ℝ) : Tendsto (fun A : ℝ ↦ ((M ^ 2 + M) * exp (-A) / (1 - exp (-A))) / r0) atTop (𝓝 0) := by have hn : Tendsto (fun A : ℝ ↦ (M ^ 2 + M) * exp (-A)) atTop (𝓝 0) := by simpa using tendsto_exp_neg_atTop_nhds_zero.const_mul (M ^ 2 + M) have hd : Tendsto (fun A : ℝ ↦ 1 - exp (-A)) atTop (𝓝 1) := by simpa using tendsto_const_nhds.sub tendsto_exp_neg_atTop_nhds_zero simpa using (hn.div hd (by norm_num : (1 : ℝ) ≠ 0)).div_const r0 /-- One lower cutoff in logarithmic scale makes count irregularity rare uniformly over every finite prime universe, band family, and number of bands. -/ theorem exists_uniform_primeCountRegularity_cutoff {M r0 err : ℝ} (hM : 0 ≤ M) (hr0 : 0 < r0) (herr : 0 < err) : ∃ A0 : ℝ, 0 < A0 ∧ ∀ A : ℝ, A0 ≤ A → ∀ (P : Finset ℕ) (lam : ℝ), (∀ p ∈ P, p.Prime) → 0 < lam → ∀ (k : ℕ) (B : ℕ → Finset ℕ), (∀ j < k, B j ⊆ P) → (∀ j < k, (∑ p ∈ B j, primeTiltSelectionProbability lam p) ≤ M) → (∑ T ∈ P.powerset with r0 ≤ primeCountRegularity A k B T, primeTiltWeight P lam T) ≤ err := by obtain ⟨a0, ha0⟩ := eventually_atTop.mp ((tendsto_primeCountRegularity_bound_zero M r0).eventually_lt_const herr) refine ⟨max a0 1, lt_of_lt_of_le (by norm_num : (0 : ℝ) < 1) (le_max_right _ _), ?_⟩ intro A hA P lam hP hlam k B hB hmean have hApos : 0 < A := lt_of_lt_of_le (by norm_num : (0 : ℝ) < 1) ((le_max_right _ _).trans hA) exact (primeCountRegularity_bad_weight_le hP hlam hApos hM hr0 k B hB hmean).trans (ha0 A ((le_max_left _ _).trans hA)).le end Erdos859Verification end /- Inlined development module: CollisionEnergyBound.lean -/ section /- Scalar conversion from a collision bound to the required energy scale. -/ open Real namespace Erdos859Verification theorem collision_energy_scale_bound {k : ℕ} {A b d K eps D C : ℝ} (hA : 0 < A) (hb : 0 < b) (hd : 1 ≤ d) (hscale : b * A ≤ d) (hK : 0 ≤ K) (heps : 0 < eps) (hC : C ≤ (2 : ℝ) ^ D / (2 : ℝ) ^ k + K * (d + 1) * ((2 : ℝ) ^ (D + 1) / (A * (2 : ℝ) ^ k * (1 - (2 : ℝ) ^ (-eps))))) : C / d ≤ ((2 : ℝ) ^ D / b + 2 * K * (2 : ℝ) ^ (D + 1) / (1 - (2 : ℝ) ^ (-eps))) / (A * (2 : ℝ) ^ k) := by have hd0 : 0 < d := lt_of_lt_of_le zero_lt_one hd have htwo : (0 : ℝ) < 2 ^ k := by positivity have hq : 0 < 1 - (2 : ℝ) ^ (-eps) := by exact sub_pos.mpr (rpow_lt_one_of_one_lt_of_neg (by norm_num) (by linarith)) let R : ℝ := (2 : ℝ) ^ (D + 1) / (A * (2 : ℝ) ^ k * (1 - (2 : ℝ) ^ (-eps))) have hR : 0 ≤ R := by dsimp [R]; positivity have hdiag : ((2 : ℝ) ^ D / (2 : ℝ) ^ k) / d ≤ ((2 : ℝ) ^ D / b) / (A * (2 : ℝ) ^ k) := by calc _ = (2 : ℝ) ^ D / (d * (2 : ℝ) ^ k) := by ring _ ≤ (2 : ℝ) ^ D / ((b * A) * (2 : ℝ) ^ k) := div_le_div_of_nonneg_left (rpow_pos_of_pos (by norm_num) _).le (by positivity) (mul_le_mul_of_nonneg_right hscale htwo.le) _ = _ := by ring have hratio : (d + 1) / d ≤ 2 := (div_le_iff₀ hd0).mpr (by linarith) calc C / d ≤ ((2 : ℝ) ^ D / (2 : ℝ) ^ k + K * (d + 1) * R) / d := div_le_div_of_nonneg_right hC hd0.le _ = ((2 : ℝ) ^ D / (2 : ℝ) ^ k) / d + K * R * ((d + 1) / d) := by ring _ ≤ ((2 : ℝ) ^ D / b) / (A * (2 : ℝ) ^ k) + K * R * 2 := add_le_add hdiag (mul_le_mul_of_nonneg_left hratio (mul_nonneg hK hR)) _ = _ := by dsimp [R] simp only [div_eq_mul_inv, mul_inv_rev] ring end Erdos859Verification end /- Inlined development module: PrimeMarkCollision.lean -/ section /- Explicit finite collision estimates on dyadic logarithmic prime bands. -/ open Finset Real namespace Erdos859Verification theorem dyadic_band_collision_series_bound {ι : Type*} [Fintype ι] {k : ℕ} (band : ι → Fin k) {A eps D : ℝ} (hA : 0 < A) (heps : 0 < eps) (hbarrier : ∀ j : Fin k, (1 + eps) * ((k - 1 - j.val : ℕ) : ℝ) - D ≤ ((univ.filter (fun i ↦ j < band i)).card : ℝ)) : (∑ j : Fin k, (1 / (A * (2 : ℝ) ^ j.val)) / (2 : ℝ) ^ (univ.filter (fun i ↦ j < band i)).card) ≤ (2 : ℝ) ^ (D + 1) / (A * (2 : ℝ) ^ k * (1 - (2 : ℝ) ^ (-eps))) := by classical let s : ℕ → ℝ := fun r ↦ ((univ.filter (fun i ↦ k - 1 - r < (band i).val)).card : ℝ) have hs : ∀ r < k, (1 + eps) * (r : ℝ) - D ≤ s r := by intro r hr have hj : k - 1 - r < k := by omega have hrev : k - 1 - (k - 1 - r) = r := by omega simpa only [s, Fin.lt_def, hrev] using hbarrier ⟨k - 1 - r, hj⟩ have heq : (∑ j : Fin k, (1 / (A * (2 : ℝ) ^ j.val)) / (2 : ℝ) ^ (univ.filter (fun i ↦ j < band i)).card) = ∑ r ∈ range k, (2 : ℝ) ^ (-s r) / (A * (2 : ℝ) ^ (k - 1 - r)) := by simp_rw [Fin.lt_def] rw [Fin.sum_univ_eq_sum_range (fun j : ℕ ↦ (1 / (A * (2 : ℝ) ^ j)) / (2 : ℝ) ^ (univ.filter (fun i ↦ j < (band i).val)).card)] rw [← sum_range_reflect (fun j ↦ (1 / (A * (2 : ℝ) ^ j)) / (2 : ℝ) ^ (univ.filter (fun i ↦ j < (band i).val)).card) k] apply sum_congr rfl intro r _hr rw [rpow_neg (by norm_num : (0 : ℝ) ≤ 2), rpow_natCast] ring rw [heq] exact geometric_collision_sum_bound hA heps hs theorem dyadic_total_collision_bound {N k : ℕ} {D : ℝ} (hcount : (k : ℝ) - D ≤ N) : 1 / (2 : ℝ) ^ N ≤ (2 : ℝ) ^ D / (2 : ℝ) ^ k := by calc _ = (2 : ℝ) ^ (-(N : ℝ)) := by rw [rpow_neg (by norm_num), rpow_natCast, one_div] _ ≤ (2 : ℝ) ^ (D - k) := rpow_le_rpow_of_exponent_le (by norm_num) (by linarith) _ = _ := by rw [rpow_sub (by norm_num), rpow_natCast] noncomputable def finiteSubsetSumCollision {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} [∀ i, Fintype (α i)] (w mark : ∀ i, α i → ℝ) (h : ℝ) : ℝ := by classical exact fairBitPairMean (fun b b' ↦ ∑ x : ∀ i, α i, finiteProductWeight w x * (if |∑ i, fairBitDifference (b i) (b' i) * mark i (x i)| ≤ h then 1 else 0)) /-- The reverse barrier turns the exact finite collision inequality into an explicit bound at the top dyadic scale. -/ theorem finiteSubsetSumCollision_dyadic_bound {ι : Type*} [Fintype ι] [DecidableEq ι] {k : ℕ} (band : ι → Fin k) {α : ι → Type*} [∀ i, Fintype (α i)] (w mark : ∀ i, α i → ℝ) {A eps D K h : ℝ} (hA : 0 < A) (heps : 0 < eps) (hK : 0 ≤ K) (hh : 0 ≤ h) (hw : ∀ i y, 0 ≤ w i y) (hnorm : ∀ i, ∑ y, w i y = 1) (hsmall : ∀ i u, ∑ y, w i y * (if |mark i y - u| ≤ h then 1 else 0) ≤ K * (h + 1) / (A * (2 : ℝ) ^ (band i).val)) (hbarrier : ∀ j : Fin k, (1 + eps) * ((k - 1 - j.val : ℕ) : ℝ) - D ≤ ((univ.filter (fun i ↦ j < band i)).card : ℝ)) (htotal : (k : ℝ) - D ≤ Fintype.card ι) : finiteSubsetSumCollision w mark h ≤ (2 : ℝ) ^ D / (2 : ℝ) ^ k + K * (h + 1) * ((2 : ℝ) ^ (D + 1) / (A * (2 : ℝ) ^ k * (1 - (2 : ℝ) ^ (-eps)))) := by classical have hfirst := finite_mark_subsetSum_collision_bound band w mark (fun j ↦ K * (h + 1) / (A * (2 : ℝ) ^ j.val)) h hw hnorm (fun _ ↦ by positivity) hh hsmall calc finiteSubsetSumCollision w mark h ≤ 1 / (2 : ℝ) ^ Fintype.card ι + ∑ j : Fin k, (K * (h + 1) / (A * (2 : ℝ) ^ j.val)) / (2 : ℝ) ^ (univ.filter (fun i ↦ j < band i)).card := hfirst _ ≤ (2 : ℝ) ^ D / (2 : ℝ) ^ k + ∑ j : Fin k, (K * (h + 1) / (A * (2 : ℝ) ^ j.val)) / (2 : ℝ) ^ (univ.filter (fun i ↦ j < band i)).card := add_le_add (dyadic_total_collision_bound htotal) le_rfl _ = (2 : ℝ) ^ D / (2 : ℝ) ^ k + K * (h + 1) * ∑ j : Fin k, (1 / (A * (2 : ℝ) ^ j.val)) / (2 : ℝ) ^ (univ.filter (fun i ↦ j < band i)).card := by congr 1 rw [mul_sum] apply sum_congr rfl intro j _ ring _ ≤ _ := add_le_add le_rfl (mul_le_mul_of_nonneg_left (dyadic_band_collision_series_bound band hA heps hbarrier) (by positivity)) /-- Dividing by a smoothing width comparable to the bottom scale gives the energy bound needed for a positive-measure support. -/ theorem finiteSubsetSumCollision_energy_bound {ι : Type*} [Fintype ι] [DecidableEq ι] {k : ℕ} (band : ι → Fin k) {α : ι → Type*} [∀ i, Fintype (α i)] (w mark : ∀ i, α i → ℝ) {A b d eps D K : ℝ} (hA : 0 < A) (hb : 0 < b) (hd : 1 ≤ d) (hscale : b * A ≤ d) (heps : 0 < eps) (hK : 0 ≤ K) (hw : ∀ i y, 0 ≤ w i y) (hnorm : ∀ i, ∑ y, w i y = 1) (hsmall : ∀ i u, ∑ y, w i y * (if |mark i y - u| ≤ d then 1 else 0) ≤ K * (d + 1) / (A * (2 : ℝ) ^ (band i).val)) (hbarrier : ∀ j : Fin k, (1 + eps) * ((k - 1 - j.val : ℕ) : ℝ) - D ≤ ((univ.filter (fun i ↦ j < band i)).card : ℝ)) (htotal : (k : ℝ) - D ≤ Fintype.card ι) : finiteSubsetSumCollision w mark d / d ≤ ((2 : ℝ) ^ D / b + 2 * K * (2 : ℝ) ^ (D + 1) / (1 - (2 : ℝ) ^ (-eps))) / (A * (2 : ℝ) ^ k) := collision_energy_scale_bound hA hb hd hscale hK heps (finiteSubsetSumCollision_dyadic_bound band w mark hA heps hK (zero_le_one.trans hd) hw hnorm hsmall hbarrier htotal) end Erdos859Verification end /- Inlined development module: DyadicPrimeMarks.lean -/ section /- The dyadic energy estimate for the actual reciprocal-prime mark laws. -/ open Finset Real namespace Erdos859Verification abbrev DyadicPrimeMark (A : ℝ) (j : ℕ) : Type := ↥(primeLogWindow (A * (2 : ℝ) ^ j) (2 * (A * (2 : ℝ) ^ j))) noncomputable def dyadicPrimeMarkWeight (A : ℝ) (j : ℕ) (p : DyadicPrimeMark A j) : ℝ := primeLogMarkWeight (A * (2 : ℝ) ^ j) (2 * (A * (2 : ℝ) ^ j)) p noncomputable def primeLogCollisionConstant : ℝ := (4 + 4 * mertensErrorConstant) / log 2 theorem primeLogCollisionConstant_pos : 0 < primeLogCollisionConstant := by unfold primeLogCollisionConstant positivity [mertensErrorConstant_pos, log_pos (by norm_num : (1 : ℝ) < 2)] theorem dyadicPrimeMark_scale_conditions {A : ℝ} (ha : log 2 ≤ A) (hlarge : 4 * mertensErrorConstant ≤ A * log 2) (j : ℕ) : log 2 ≤ A * (2 : ℝ) ^ j ∧ 4 * mertensErrorConstant ≤ (A * (2 : ℝ) ^ j) * log 2 := by have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hscale : A ≤ A * (2 : ℝ) ^ j := le_mul_of_one_le_right (hlog.le.trans ha) (one_le_pow₀ (by norm_num)) exact ⟨ha.trans hscale, hlarge.trans (mul_le_mul_of_nonneg_right hscale hlog.le)⟩ theorem dyadicPrimeMarkWeight_normalized {A : ℝ} (ha : log 2 ≤ A) (hlarge : 4 * mertensErrorConstant ≤ A * log 2) (j : ℕ) : (∀ p : DyadicPrimeMark A j, 0 ≤ dyadicPrimeMarkWeight A j p) ∧ (∑ p : DyadicPrimeMark A j, dyadicPrimeMarkWeight A j p) = 1 := by obtain ⟨ha', hlarge'⟩ := dyadicPrimeMark_scale_conditions ha hlarge j have hmass := primeLogWindowMass_dyadic_lower ha' hlarge' have hmasspos : 0 < primeLogWindowMass (A * (2 : ℝ) ^ j) (2 * (A * (2 : ℝ) ^ j)) := (half_pos (log_pos (by norm_num : (1 : ℝ) < 2))).trans_le hmass constructor · intro p unfold dyadicPrimeMarkWeight primeLogMarkWeight positivity · unfold dyadicPrimeMarkWeight rw [sum_coe_sort] exact sum_primeLogMarkWeight hmasspos theorem dyadicPrimeMarkWeight_smallBall {A h : ℝ} (ha : log 2 ≤ A) (hlarge : 4 * mertensErrorConstant ≤ A * log 2) (hh : 0 ≤ h) (j : ℕ) (u : ℝ) : (∑ p : DyadicPrimeMark A j, dyadicPrimeMarkWeight A j p * (if |log (p : ℕ) - u| ≤ h then 1 else 0)) ≤ primeLogCollisionConstant * (h + 1) / (A * (2 : ℝ) ^ j) := by obtain ⟨ha', hlarge'⟩ := dyadicPrimeMark_scale_conditions ha hlarge j have hbound := primeLogMark_subtype_smallBall (u := u) ha' hlarge' hh simpa only [dyadicPrimeMarkWeight, primeLogCollisionConstant, mul_div_assoc] using hbound /-- Independent reciprocal-prime marks satisfying the reverse-count barrier have collision energy bounded by a constant divided by the top log scale. -/ theorem dyadicPrimeMark_collision_energy_bound {ι : Type*} [Fintype ι] [DecidableEq ι] {k : ℕ} (band : ι → Fin k) {A b d eps D : ℝ} (ha : log 2 ≤ A) (hlarge : 4 * mertensErrorConstant ≤ A * log 2) (hb : 0 < b) (hd : 1 ≤ d) (hscale : b * A ≤ d) (heps : 0 < eps) (hbarrier : ∀ j : Fin k, (1 + eps) * ((k - 1 - j.val : ℕ) : ℝ) - D ≤ ((univ.filter (fun i ↦ j < band i)).card : ℝ)) (htotal : (k : ℝ) - D ≤ Fintype.card ι) : finiteSubsetSumCollision (fun i ↦ dyadicPrimeMarkWeight A (band i).val) (fun _ p ↦ log (p : ℕ)) d / d ≤ ((2 : ℝ) ^ D / b + 2 * primeLogCollisionConstant * (2 : ℝ) ^ (D + 1) / (1 - (2 : ℝ) ^ (-eps))) / (A * (2 : ℝ) ^ k) := by apply finiteSubsetSumCollision_energy_bound band _ _ ((log_pos (by norm_num : (1 : ℝ) < 2)).trans_le ha) hb hd hscale heps primeLogCollisionConstant_pos.le · intro i exact (dyadicPrimeMarkWeight_normalized ha hlarge (band i).val).1 · intro i exact (dyadicPrimeMarkWeight_normalized ha hlarge (band i).val).2 · intro i u exact dyadicPrimeMarkWeight_smallBall ha hlarge (zero_le_one.trans hd) (band i).val u · exact hbarrier · exact htotal end Erdos859Verification end /- Inlined development module: FiniteSmoothing.lean -/ section /- Interval smoothing of a finite weighted point law. -/ open Finset MeasureTheory namespace Erdos859Verification noncomputable def intervalSmoothingKernel (d x y : ℝ) : ℝ := (Set.Icc x (x + d)).indicator (fun _ ↦ 1 / d) y noncomputable def finiteIntervalSmoothing {ι : Type*} [Fintype ι] (w atom : ι → ℝ) (d y : ℝ) : ℝ := ∑ i, w i * intervalSmoothingKernel d (atom i) y theorem intervalSmoothingKernel_nonneg {d : ℝ} (hd : 0 ≤ d) (x y : ℝ) : 0 ≤ intervalSmoothingKernel d x y := by unfold intervalSmoothingKernel exact Set.indicator_nonneg (fun _ _ ↦ by positivity) y theorem integrable_intervalSmoothingKernel (d x : ℝ) : Integrable (intervalSmoothingKernel d x) := by apply (integrable_indicator_iff measurableSet_Icc).mpr exact integrableOn_const (by simp [Real.volume_Icc]) theorem integral_intervalSmoothingKernel {d : ℝ} (hd : 0 < d) (x : ℝ) : (∫ y, intervalSmoothingKernel d x y) = 1 := by unfold intervalSmoothingKernel rw [integral_indicator_const _ measurableSet_Icc, Real.volume_real_Icc_of_le (by linarith : x ≤ x + d)] simp [smul_eq_mul, hd.ne'] theorem intervalSmoothingKernel_mul (d x z y : ℝ) : intervalSmoothingKernel d x y * intervalSmoothingKernel d z y = (Set.Icc x (x + d) ∩ Set.Icc z (z + d)).indicator (fun _ ↦ (1 / d : ℝ) * (1 / d)) y := by exact (Set.inter_indicator_mul _ _ _).symm theorem integrable_intervalSmoothingKernel_mul (d x z : ℝ) : Integrable (fun y ↦ intervalSmoothingKernel d x y * intervalSmoothingKernel d z y) := by simp_rw [intervalSmoothingKernel_mul, Set.Icc_inter_Icc] apply (integrable_indicator_iff measurableSet_Icc).mpr exact integrableOn_const (by simp [Real.volume_Icc]) /-- The overlap of two equal-length intervals is the positive part of their length minus the distance between their starting points. -/ theorem intervalSmoothing_overlap_length (d x z : ℝ) : min (x + d) (z + d) - max x z = d - |x - z| := by rcases le_total x z with hxz | hzx · rw [min_eq_left (show x + d ≤ z + d by linarith), max_eq_right hxz, abs_of_nonpos (sub_nonpos.mpr hxz)] ring · rw [min_eq_right (show z + d ≤ x + d by linarith), max_eq_left hzx, abs_of_nonneg (sub_nonneg.mpr hzx)] ring theorem integral_intervalSmoothingKernel_mul (d x z : ℝ) : (∫ y, intervalSmoothingKernel d x y * intervalSmoothingKernel d z y) = max (d - |x - z|) 0 / d ^ 2 := by simp_rw [intervalSmoothingKernel_mul] rw [integral_indicator_const _ (measurableSet_Icc.inter measurableSet_Icc), Set.Icc_inter_Icc, Real.volume_real_Icc] change max (min (x + d) (z + d) - max x z) 0 * (1 / d * (1 / d)) = _ rw [intervalSmoothing_overlap_length] ring theorem integrable_finiteIntervalSmoothing {ι : Type*} [Fintype ι] (w atom : ι → ℝ) (d : ℝ) : Integrable (finiteIntervalSmoothing w atom d) := by exact integrable_finsetSum univ (fun i _ ↦ (integrable_intervalSmoothingKernel d (atom i)).const_mul (w i)) theorem finiteIntervalSmoothing_nonneg {ι : Type*} [Fintype ι] (w atom : ι → ℝ) {d : ℝ} (hd : 0 ≤ d) (hw : ∀ i, 0 ≤ w i) (y : ℝ) : 0 ≤ finiteIntervalSmoothing w atom d y := by exact sum_nonneg (fun i _ ↦ mul_nonneg (hw i) (intervalSmoothingKernel_nonneg hd _ _)) theorem integral_finiteIntervalSmoothing {ι : Type*} [Fintype ι] (w atom : ι → ℝ) {d : ℝ} (hd : 0 < d) (hnorm : ∑ i, w i = 1) : (∫ y, finiteIntervalSmoothing w atom d y) = 1 := by unfold finiteIntervalSmoothing rw [integral_finsetSum univ (fun i _ ↦ (integrable_intervalSmoothingKernel d (atom i)).const_mul (w i))] simp_rw [integral_const_mul, integral_intervalSmoothingKernel hd, mul_one] exact hnorm theorem finiteIntervalSmoothing_sq_eq {ι : Type*} [Fintype ι] (w atom : ι → ℝ) (d y : ℝ) : finiteIntervalSmoothing w atom d y ^ 2 = ∑ i, ∑ j, (w i * w j) * (intervalSmoothingKernel d (atom i) y * intervalSmoothingKernel d (atom j) y) := by rw [finiteIntervalSmoothing, pow_two, sum_mul_sum] apply sum_congr rfl intro i _ apply sum_congr rfl intro j _ ring theorem integrable_finiteIntervalSmoothing_sq {ι : Type*} [Fintype ι] (w atom : ι → ℝ) (d : ℝ) : Integrable (fun y ↦ finiteIntervalSmoothing w atom d y ^ 2) := by simp_rw [finiteIntervalSmoothing_sq_eq] exact integrable_finsetSum univ (fun i _ ↦ integrable_finsetSum univ (fun j _ ↦ (integrable_intervalSmoothingKernel_mul d (atom i) (atom j)).const_mul (w i * w j))) /-- The exact second moment of a finitely supported law after interval smoothing. -/ theorem integral_finiteIntervalSmoothing_sq {ι : Type*} [Fintype ι] (w atom : ι → ℝ) (d : ℝ) : (∫ y, finiteIntervalSmoothing w atom d y ^ 2) = ∑ i, ∑ j, (w i * w j) * (max (d - |atom i - atom j|) 0 / d ^ 2) := by simp_rw [finiteIntervalSmoothing_sq_eq] rw [integral_finsetSum univ (fun i _ ↦ integrable_finsetSum univ (fun j _ ↦ (integrable_intervalSmoothingKernel_mul d (atom i) (atom j)).const_mul (w i * w j)))] apply sum_congr rfl intro i _ rw [integral_finsetSum univ (fun j _ ↦ (integrable_intervalSmoothingKernel_mul d (atom i) (atom j)).const_mul (w i * w j))] simp_rw [integral_const_mul, integral_intervalSmoothingKernel_mul] theorem intervalSmoothing_overlap_le_collision {d : ℝ} (hd : 0 < d) (x z : ℝ) : max (d - |x - z|) 0 / d ^ 2 ≤ (if |x - z| ≤ d then 1 else 0) / d := by by_cases hxz : |x - z| ≤ d · rw [if_pos hxz, max_eq_left (sub_nonneg.mpr hxz)] calc (d - |x - z|) / d ^ 2 ≤ d / d ^ 2 := div_le_div_of_nonneg_right (by linarith [abs_nonneg (x - z)]) (sq_nonneg d) _ = 1 / d := by field_simp [hd.ne'] · rw [if_neg hxz, max_eq_right (by linarith : d - |x - z| ≤ 0)] simp /-- A small-ball collision bound controls the smoothed second moment. -/ theorem integral_finiteIntervalSmoothing_sq_le_collision {ι : Type*} [Fintype ι] (w atom : ι → ℝ) {d : ℝ} (hd : 0 < d) (hw : ∀ i, 0 ≤ w i) : (∫ y, finiteIntervalSmoothing w atom d y ^ 2) ≤ (∑ i, ∑ j, (w i * w j) * (if |atom i - atom j| ≤ d then 1 else 0)) / d := by rw [integral_finiteIntervalSmoothing_sq] simp only [sum_div, ← mul_div_assoc] apply sum_le_sum intro i _ apply sum_le_sum intro j _ simpa only [mul_div_assoc] using mul_le_mul_of_nonneg_left (intervalSmoothing_overlap_le_collision hd (atom i) (atom j)) (mul_nonneg (hw i) (hw j)) def finiteIntervalSupport {ι : Type*} (atom : ι → ℝ) (d : ℝ) : Set ℝ := ⋃ i, Set.Icc (atom i) (atom i + d) theorem isCompact_finiteIntervalSupport {ι : Type*} [Fintype ι] (atom : ι → ℝ) (d : ℝ) : IsCompact (finiteIntervalSupport atom d) := isCompact_iUnion (fun _ ↦ isCompact_Icc) theorem finiteIntervalSmoothing_eq_zero_of_not_mem {ι : Type*} [Fintype ι] (w atom : ι → ℝ) (d y : ℝ) (hy : y ∉ finiteIntervalSupport atom d) : finiteIntervalSmoothing w atom d y = 0 := by apply sum_eq_zero intro i _ have hi : y ∉ Set.Icc (atom i) (atom i + d) := by intro h exact hy (Set.mem_iUnion.mpr ⟨i, h⟩) simp [intervalSmoothingKernel, hi] /-- Cauchy--Schwarz in a form suited to a normalized density with finite support measure. -/ theorem normalized_density_support_measure {f : ℝ → ℝ} {S : Set ℝ} (hf : Integrable f) (hf2 : Integrable (fun y ↦ f y ^ 2)) (hf0 : ∀ y, 0 ≤ f y) (hnorm : (∫ y, f y) = 1) (hS : MeasurableSet S) (hfin : volume S ≠ ⊤) (hsupport : ∀ y ∉ S, f y = 0) : 1 ≤ volume.real S * (∫ y, f y ^ 2) := by let g : ℝ → ℝ := S.indicator (fun _ ↦ 1) have hg0 : ∀ y, 0 ≤ g y := Set.indicator_nonneg (fun _ _ ↦ zero_le_one) have hgf : (fun y ↦ f y * g y) = f := by funext y by_cases hy : y ∈ S · simp [g, hy] · simp [g, hy, hsupport y hy] have hg2 : (fun y ↦ g y ^ 2) = g := by funext y by_cases hy : y ∈ S <;> simp [g, hy] have hgint : (∫ y, g y) = volume.real S := by simp [g, integral_indicator_const, hS] have hfLp : MemLp f (ENNReal.ofReal (2 : ℝ)) := by simpa using (memLp_two_iff_integrable_sq hf.aestronglyMeasurable).mpr hf2 have hgLp : MemLp g (ENNReal.ofReal (2 : ℝ)) := memLp_indicator_const _ hS 1 (Or.inr hfin) have hholder := integral_mul_le_Lp_mul_Lq_of_nonneg Real.HolderConjugate.two_two (Filter.Eventually.of_forall hf0) (Filter.Eventually.of_forall hg0) hfLp hgLp simp only [Real.rpow_two, ← Real.sqrt_eq_rpow] at hholder rw [hgf, hnorm, hg2, hgint] at hholder have hsquare := (one_le_sq_iff₀ (mul_nonneg (Real.sqrt_nonneg _) (Real.sqrt_nonneg _))).mpr hholder have henergy : 0 ≤ ∫ y, f y ^ 2 := integral_nonneg (fun _ ↦ sq_nonneg _) simpa only [mul_pow, Real.sq_sqrt henergy, Real.sq_sqrt measureReal_nonneg, mul_comm] using hsquare theorem finiteIntervalSmoothing_support_measure {ι : Type*} [Fintype ι] (w atom : ι → ℝ) {d : ℝ} (hd : 0 < d) (hw : ∀ i, 0 ≤ w i) (hnorm : ∑ i, w i = 1) : 1 ≤ volume.real (finiteIntervalSupport atom d) * (∫ y, finiteIntervalSmoothing w atom d y ^ 2) := by have hcompact := isCompact_finiteIntervalSupport atom d exact normalized_density_support_measure (integrable_finiteIntervalSmoothing w atom d) (integrable_finiteIntervalSmoothing_sq w atom d) (finiteIntervalSmoothing_nonneg w atom hd.le hw) (integral_finiteIntervalSmoothing w atom hd hnorm) hcompact.measurableSet hcompact.measure_ne_top (finiteIntervalSmoothing_eq_zero_of_not_mem w atom d) /-- An upper bound on the smoothed energy yields a reciprocal lower bound on the measure of the thickened finite set. -/ theorem finiteIntervalSupport_measure_lower_of_energy {ι : Type*} [Fintype ι] (w atom : ι → ℝ) {d K : ℝ} (hd : 0 < d) (hK : 0 < K) (hw : ∀ i, 0 ≤ w i) (hnorm : ∑ i, w i = 1) (henergy : (∫ y, finiteIntervalSmoothing w atom d y ^ 2) ≤ K) : 1 / K ≤ volume.real (finiteIntervalSupport atom d) := by apply (div_le_iff₀ hK).mpr calc 1 ≤ volume.real (finiteIntervalSupport atom d) * (∫ y, finiteIntervalSmoothing w atom d y ^ 2) := finiteIntervalSmoothing_support_measure w atom hd hw hnorm _ ≤ _ := mul_le_mul_of_nonneg_left henergy measureReal_nonneg /-- A weighted collision probability at radius `d` at most `r` forces the union of length-`d` intervals to have measure at least `d/r`. -/ theorem finiteIntervalSupport_measure_lower_of_collision {ι : Type*} [Fintype ι] (w atom : ι → ℝ) {d r : ℝ} (hd : 0 < d) (hr : 0 < r) (hw : ∀ i, 0 ≤ w i) (hnorm : ∑ i, w i = 1) (hcollision : (∑ i, ∑ j, (w i * w j) * (if |atom i - atom j| ≤ d then 1 else 0)) ≤ r) : d / r ≤ volume.real (finiteIntervalSupport atom d) := by have henergy : (∫ y, finiteIntervalSmoothing w atom d y ^ 2) ≤ r / d := (integral_finiteIntervalSmoothing_sq_le_collision w atom hd hw).trans (div_le_div_of_nonneg_right hcollision hd.le) have hbound := finiteIntervalSupport_measure_lower_of_energy w atom hd (div_pos hr hd) hw hnorm henergy simpa only [one_div_div] using hbound /-- Thickening is monotone in the underlying finite set of atom locations. -/ theorem finiteIntervalSupport_mono_range {ι κ : Type*} (atom : ι → ℝ) (atom' : κ → ℝ) (d : ℝ) (hrange : Set.range atom ⊆ Set.range atom') : finiteIntervalSupport atom d ⊆ finiteIntervalSupport atom' d := by intro y hy obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hy obtain ⟨j, hj⟩ := hrange ⟨i, rfl⟩ exact Set.mem_iUnion.mpr ⟨j, by simpa only [hj] using hi⟩ theorem finiteIntervalSupport_subset_Icc {ι : Type*} (atom : ι → ℝ) (d L R : ℝ) (hlo : ∀ i, L ≤ atom i) (hhi : ∀ i, atom i + d ≤ R) : finiteIntervalSupport atom d ⊆ Set.Icc L R := by intro y hy obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hy exact ⟨(hlo i).trans hi.1, hi.2.trans (hhi i)⟩ end Erdos859Verification end /- Inlined development module: PrimeTupleOdds.lean -/ section /- Exact conversion from fixed-cardinality subsets to distinct ordered tuples. -/ namespace Erdos859Verification open Finset def tupleSupport {α : Type*} [DecidableEq α] {P : Finset α} {n : ℕ} (x : Fin n → P) : Finset α := univ.image (fun i ↦ (x i).val) theorem tupleSupport_subset {α : Type*} [DecidableEq α] {P : Finset α} {n : ℕ} (x : Fin n → P) : tupleSupport x ⊆ P := by intro p hp obtain ⟨i, _, rfl⟩ := mem_image.mp hp exact (x i).property theorem card_tupleSupport {α : Type*} [DecidableEq α] {P : Finset α} {n : ℕ} (x : Fin n → P) (hx : Function.Injective x) : (tupleSupport x).card = n := by rw [tupleSupport, card_image_of_injective] · exact card_fin n · intro i j hij exact hx (Subtype.ext hij) theorem prod_tupleSupport {α : Type*} [DecidableEq α] {P : Finset α} {n : ℕ} (x : Fin n → P) (hx : Function.Injective x) (w : α → ℝ) : (∏ p ∈ tupleSupport x, w p) = ∏ i, w (x i).val := by rw [tupleSupport, prod_image] intro i _ j _ hij exact hx (Subtype.ext hij) noncomputable def tupleSupportFiberEquiv {α : Type*} [DecidableEq α] {P T : Finset α} {n : ℕ} (hTP : T ⊆ P) (hT : T.card = n) : {x : Fin n → P // Function.Injective x ∧ tupleSupport x = T} ≃ (Fin n ↪ T) := by classical have hsurj (e : Fin n ↪ T) : Function.Surjective e := ((Fintype.bijective_iff_injective_and_card e).mpr ⟨e.injective, by simp [hT]⟩).2 refine { toFun := fun x ↦ { toFun := fun i ↦ ⟨(x.val i).val, ?_⟩ inj' := ?_ } invFun := fun e ↦ ⟨fun i ↦ ⟨(e i).val, hTP (e i).property⟩, ?_, ?_⟩ left_inv := ?_ right_inv := ?_ } · have hm : (x.val i).val ∈ tupleSupport x.val := mem_image.mpr ⟨i, mem_univ i, rfl⟩ exact (congrArg (fun S : Finset α ↦ (x.val i).val ∈ S) x.property.2).mp hm · intro i j hij apply x.property.1 apply Subtype.ext exact congrArg (fun z : T ↦ z.val) hij · intro i j hij apply e.injective apply Subtype.ext exact congrArg (fun z : P ↦ z.val) hij · ext p constructor · intro hp obtain ⟨i, _, rfl⟩ := mem_image.mp hp exact (e i).property · intro hp obtain ⟨i, hi⟩ := hsurj e ⟨p, hp⟩ exact mem_image.mpr ⟨i, mem_univ i, congrArg Subtype.val hi⟩ · intro x apply Subtype.ext funext i rfl · intro e apply Function.Embedding.ext intro i rfl theorem card_tupleSupport_fiber {α : Type*} [DecidableEq α] {P T : Finset α} {n : ℕ} (hTP : T ⊆ P) (hT : T.card = n) : (univ.filter (fun x : Fin n → P ↦ Function.Injective x ∧ tupleSupport x = T)).card = n.factorial := by classical have h := Fintype.card_congr (tupleSupportFiberEquiv hTP hT) simpa only [Fintype.card_subtype, Fintype.card_embedding_eq, Fintype.card_coe, Fintype.card_fin, hT, Nat.descFactorial_self] using h theorem sum_injective_tuple_support {α : Type*} [DecidableEq α] (P : Finset α) (n : ℕ) (G : Finset α → ℝ) : (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), G (tupleSupport x)) = (n.factorial : ℝ) * ∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), G T := by classical let S := univ.filter (Function.Injective : (Fin n → P) → Prop) let Q := P.powerset.filter (fun T ↦ T.card = n) have hmap : ∀ x ∈ S, tupleSupport x ∈ Q := by intro x hx exact mem_filter.mpr ⟨mem_powerset.mpr (tupleSupport_subset x), card_tupleSupport x (mem_filter.mp hx).2⟩ change (∑ x ∈ S, G (tupleSupport x)) = (n.factorial : ℝ) * ∑ T ∈ Q, G T calc _ = ∑ T ∈ Q, ∑ x ∈ S.filter (fun x ↦ tupleSupport x = T), G T := (sum_fiberwise_of_maps_to' hmap G).symm _ = ∑ T ∈ Q, (n.factorial : ℝ) * G T := by apply sum_congr rfl intro T hT have heq : S.filter (fun x ↦ tupleSupport x = T) = univ.filter (fun x : Fin n → P ↦ Function.Injective x ∧ tupleSupport x = T) := by ext x simp [S] have hc : (S.filter (fun x ↦ tupleSupport x = T)).card = n.factorial := by rw [heq] exact card_tupleSupport_fiber (mem_powerset.mp (mem_filter.mp hT).1) (mem_filter.mp hT).2 simp only [sum_const, hc, nsmul_eq_mul] _ = _ := (mul_sum _ _ _).symm theorem sum_injective_tuple_product {α : Type*} [DecidableEq α] (P : Finset α) (n : ℕ) (w : α → ℝ) (F : Finset α → ℝ) : (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, w (x i).val) * F (tupleSupport x)) = (n.factorial : ℝ) * ∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), (∏ p ∈ T, w p) * F T := by calc _ = ∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ p ∈ tupleSupport x, w p) * F (tupleSupport x) := by apply sum_congr rfl intro x hx rw [prod_tupleSupport x (mem_filter.mp hx).2] _ = _ := sum_injective_tuple_support P n (fun T ↦ (∏ p ∈ T, w p) * F T) theorem injective_tuple_product_expectation {α : Type*} [DecidableEq α] (P : Finset α) (n : ℕ) (w : α → ℝ) (F : Finset α → ℝ) : (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, w (x i).val) * F (tupleSupport x)) / (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), ∏ i, w (x i).val) = (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), (∏ p ∈ T, w p) * F T) / (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), ∏ p ∈ T, w p) := by have hden := sum_injective_tuple_product P n w (fun _ ↦ 1) simp only [mul_one] at hden rw [sum_injective_tuple_product, hden] exact mul_div_mul_left _ _ (by exact_mod_cast (Nat.factorial_ne_zero n)) theorem primeTilt_fixedCard_expectation_eq_ordered_odds {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (n : ℕ) (F : Finset ℕ → ℝ) : (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T * F T) / (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T) = (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, 1 / (((x i).val : ℝ) - 1)) * F (tupleSupport x)) / (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), ∏ i, 1 / (((x i).val : ℝ) - 1)) := by rw [primeTilt_fixedCard_expectation_eq_odds hP hlam] exact (injective_tuple_product_expectation P n (fun p ↦ 1 / ((p : ℝ) - 1)) F).symm noncomputable def reciprocalTupleWeight {P : Finset ℕ} {n : ℕ} (M : ℝ) (x : Fin n → P) : ℝ := finiteProductWeight (fun _ p ↦ (1 / (p.val : ℝ)) / M) x noncomputable def primeTupleOddsRatio {P : Finset ℕ} {n : ℕ} (x : Fin n → P) : ℝ := ∏ i, (x i).val / (((x i).val : ℝ) - 1) theorem reciprocalTupleWeight_mul_oddsRatio {P : Finset ℕ} {n : ℕ} (hP : ∀ p ∈ P, p.Prime) (M : ℝ) (x : Fin n → P) : reciprocalTupleWeight M x * primeTupleOddsRatio x = (∏ i, 1 / (((x i).val : ℝ) - 1)) / M ^ n := by unfold reciprocalTupleWeight finiteProductWeight primeTupleOddsRatio rw [← prod_mul_distrib] calc _ = ∏ i, (1 / (((x i).val : ℝ) - 1)) / M := by apply prod_congr rfl intro i _ have hp0 : ((x i).val : ℝ) ≠ 0 := by exact_mod_cast (hP (x i).val (x i).property).ne_zero field_simp _ = _ := by rw [prod_div_distrib]; simp theorem reweighted_reciprocalTuple_expectation {P : Finset ℕ} {n : ℕ} (hP : ∀ p ∈ P, p.Prime) {M : ℝ} (hM : M ≠ 0) (F : Finset ℕ → ℝ) : (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), reciprocalTupleWeight M x * primeTupleOddsRatio x * F (tupleSupport x)) / (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), reciprocalTupleWeight M x * primeTupleOddsRatio x) = (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, 1 / (((x i).val : ℝ) - 1)) * F (tupleSupport x)) / (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), ∏ i, 1 / (((x i).val : ℝ) - 1)) := by have hnum : (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), reciprocalTupleWeight M x * primeTupleOddsRatio x * F (tupleSupport x)) = (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, 1 / (((x i).val : ℝ) - 1)) * F (tupleSupport x)) / M ^ n := by rw [sum_div] apply sum_congr rfl intro x _ rw [reciprocalTupleWeight_mul_oddsRatio hP] ring have hden : (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), reciprocalTupleWeight M x * primeTupleOddsRatio x) = (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), ∏ i, 1 / (((x i).val : ℝ) - 1)) / M ^ n := by simp_rw [reciprocalTupleWeight_mul_oddsRatio hP] rw [sum_div] rw [hnum, hden] exact div_div_div_cancel_right₀ (pow_ne_zero n hM) _ _ theorem primeTilt_fixedCard_expectation_eq_reweighted_tuples {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam M : ℝ} (hlam : 0 < lam) (hM : M ≠ 0) (n : ℕ) (F : Finset ℕ → ℝ) : (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T * F T) / (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T) = (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), reciprocalTupleWeight M x * primeTupleOddsRatio x * F (tupleSupport x)) / (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), reciprocalTupleWeight M x * primeTupleOddsRatio x) := by rw [primeTilt_fixedCard_expectation_eq_ordered_odds hP hlam] exact (reweighted_reciprocalTuple_expectation hP hM F).symm theorem primeTupleOddsRatio_bounds {P : Finset ℕ} {n : ℕ} {a : ℝ} (hP : ∀ p ∈ P, p.Prime) (hlarge : ∀ p ∈ P, a ≤ Real.log (p : ℝ)) (x : Fin n → P) (hx : Function.Injective x) : 1 ≤ primeTupleOddsRatio x ∧ primeTupleOddsRatio x ≤ Real.exp (2 * (n : ℝ) * Real.exp (-a)) := by have h := prime_odds_ratio_bounds (fun p hp ↦ hP p (tupleSupport_subset x hp)) (fun p hp ↦ hlarge p (tupleSupport_subset x hp)) rw [prod_tupleSupport x hx, card_tupleSupport x hx] at h exact h theorem primeTilt_fixedCard_expectation_le_two_iid {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam M a : ℝ} (hlam : 0 < lam) (hM : 0 < M) (n : ℕ) (F : Finset ℕ → ℝ) (hF : ∀ T, 0 ≤ F T) (hlarge : ∀ p ∈ P, a ≤ Real.log (p : ℝ)) (hratio : Real.exp (2 * (n : ℝ) * Real.exp (-a)) ≤ 3 / 2) (hmass : (3 : ℝ) / 4 ≤ ∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), reciprocalTupleWeight M x) : (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T * F T) / (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T) ≤ 2 * ∑ x : Fin n → P, reciprocalTupleWeight M x * F (tupleSupport x) := by rw [primeTilt_fixedCard_expectation_eq_reweighted_tuples hP hlam hM.ne'] apply finite_normalized_reweight_le_two _ _ _ _ · intro x unfold reciprocalTupleWeight exact finiteProductWeight_nonneg (fun _ _ ↦ by positivity) x · intro x exact hF (tupleSupport x) · intro x hx exact (primeTupleOddsRatio_bounds hP hlarge x (mem_filter.mp hx).2).1 · intro x hx exact (primeTupleOddsRatio_bounds hP hlarge x (mem_filter.mp hx).2).2.trans hratio · exact hmass end Erdos859Verification end /- Inlined development module: PrimeDyadicBarrier.lean -/ section /- Concrete dyadic prime bands and their uniform reverse-count barrier. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification noncomputable def dyadicPrimeBand (A : ℝ) (j : ℕ) : Finset ℕ := primeLogWindow (A * (2 : ℝ) ^ j) (2 * (A * (2 : ℝ) ^ j)) noncomputable def dyadicPrimeUniverse (A : ℝ) (k : ℕ) : Finset ℕ := (range k).biUnion (dyadicPrimeBand A) /-- The union of the top `ell + 1` bands when `ell < k`. -/ noncomputable def dyadicPrimeTail (A : ℝ) (k ell : ℕ) : Finset ℕ := (Ico (k - (ell + 1)) k).biUnion (dyadicPrimeBand A) theorem mem_dyadicPrimeBand {A : ℝ} {j p : ℕ} : p ∈ dyadicPrimeBand A j ↔ p.Prime ∧ A * (2 : ℝ) ^ j < log (p : ℝ) ∧ log (p : ℝ) ≤ 2 * (A * (2 : ℝ) ^ j) := mem_primeLogWindow theorem dyadicPrimeBand_prime (A : ℝ) (j : ℕ) : ∀ p ∈ dyadicPrimeBand A j, p.Prime := fun _ hp ↦ (mem_dyadicPrimeBand.mp hp).1 theorem dyadicPrimeBand_pairwise_disjoint {A : ℝ} (hA : 0 < A) : Pairwise (fun i j : ℕ ↦ Disjoint (dyadicPrimeBand A i) (dyadicPrimeBand A j)) := by have hstep {i j : ℕ} (hij : i < j) : Disjoint (dyadicPrimeBand A i) (dyadicPrimeBand A j) := by apply Finset.disjoint_left.mpr intro p hpi hpj have hi := (mem_dyadicPrimeBand.mp hpi).2.2 have hj := (mem_dyadicPrimeBand.mp hpj).2.1 have hpow : (2 : ℝ) ^ (i + 1) ≤ 2 ^ j := pow_le_pow_right₀ (by norm_num) (Nat.succ_le_of_lt hij) have hsep : 2 * (A * (2 : ℝ) ^ i) ≤ A * (2 : ℝ) ^ j := by calc _ = A * (2 : ℝ) ^ (i + 1) := by rw [pow_succ]; ring _ ≤ _ := mul_le_mul_of_nonneg_left hpow hA.le exact (not_lt_of_ge (hi.trans hsep)) hj intro i j hij rcases lt_or_gt_of_ne hij with hij | hji · exact hstep hij · exact (hstep hji).symm theorem dyadicPrimeUniverse_prime (A : ℝ) (k : ℕ) : ∀ p ∈ dyadicPrimeUniverse A k, p.Prime := by intro p hp obtain ⟨j, _, hpj⟩ := Finset.mem_biUnion.mp hp exact dyadicPrimeBand_prime A j p hpj theorem dyadicPrimeBand_subset_universe {A : ℝ} {k j : ℕ} (hj : j < k) : dyadicPrimeBand A j ⊆ dyadicPrimeUniverse A k := by intro p hp exact Finset.mem_biUnion.mpr ⟨j, Finset.mem_range.mpr hj, hp⟩ theorem dyadicPrimeTail_subset_universe (A : ℝ) (k ell : ℕ) : dyadicPrimeTail A k ell ⊆ dyadicPrimeUniverse A k := by intro p hp obtain ⟨j, hj, hpj⟩ := Finset.mem_biUnion.mp hp exact dyadicPrimeBand_subset_universe (Finset.mem_Ico.mp hj).2 hpj theorem dyadicPrimeTail_full {A : ℝ} {k : ℕ} (hk : 0 < k) : dyadicPrimeTail A k (k - 1) = dyadicPrimeUniverse A k := by have hk1 : k - 1 + 1 = k := Nat.sub_add_cancel hk simp only [dyadicPrimeTail, hk1, Nat.sub_self, Nat.Ico_zero_eq_range, dyadicPrimeUniverse] theorem sum_dyadicPrimeTail {A : ℝ} (hA : 0 < A) (k ell : ℕ) (f : ℕ → ℝ) : (∑ p ∈ dyadicPrimeTail A k ell, f p) = ∑ j ∈ Ico (k - (ell + 1)) k, ∑ p ∈ dyadicPrimeBand A j, f p := by apply sum_biUnion intro i _ j _ hij exact dyadicPrimeBand_pairwise_disjoint hA hij /-- Counts add exactly across the bands; their half-open endpoints cause no duplicate prime at an adjacent boundary. -/ theorem card_inter_dyadicPrimeBands {A : ℝ} (hA : 0 < A) (I : Finset ℕ) (T : Finset ℕ) : (T ∩ I.biUnion (dyadicPrimeBand A)).card = ∑ j ∈ I, (T ∩ dyadicPrimeBand A j).card := by have heq : T ∩ I.biUnion (dyadicPrimeBand A) = I.biUnion (fun j ↦ T ∩ dyadicPrimeBand A j) := by ext p simp only [Finset.mem_inter, Finset.mem_biUnion] aesop rw [heq] apply card_biUnion intro i _ j _ hij exact (dyadicPrimeBand_pairwise_disjoint hA hij).mono inter_subset_right inter_subset_right theorem card_inter_dyadicPrimeTail {A : ℝ} (hA : 0 < A) (k ell : ℕ) (T : Finset ℕ) : (T ∩ dyadicPrimeTail A k ell).card = ∑ j ∈ Ico (k - (ell + 1)) k, (T ∩ dyadicPrimeBand A j).card := card_inter_dyadicPrimeBands hA _ _ theorem card_inter_dyadicPrimeUniverse {A : ℝ} (hA : 0 < A) (k : ℕ) (T : Finset ℕ) : (T ∩ dyadicPrimeUniverse A k).card = ∑ j ∈ range k, (T ∩ dyadicPrimeBand A j).card := card_inter_dyadicPrimeBands hA _ _ /-- A lower mean bound on each band adds to the correct linear lower bound on every terminal union of bands. -/ theorem dyadicPrimeTail_mean_lower {A lam mu : ℝ} (hA : 0 < A) {k ell : ℕ} (hell : ell < k) (hmean : ∀ j < k, mu ≤ ∑ p ∈ dyadicPrimeBand A j, primeTiltSelectionProbability lam p) : mu * (ell + 1 : ℕ) ≤ ∑ p ∈ dyadicPrimeTail A k ell, primeTiltSelectionProbability lam p := by rw [sum_dyadicPrimeTail hA] have hcard : (Ico (k - (ell + 1)) k).card = ell + 1 := by rw [Nat.card_Ico, Nat.sub_sub_self (Nat.succ_le_of_lt hell)] calc _ = ∑ _j ∈ Ico (k - (ell + 1)) k, mu := by simp [hcard, mul_comm] _ ≤ _ := sum_le_sum (fun j hj ↦ hmean j (Finset.mem_Ico.mp hj).2) /-- Once the bottom band is high enough, the sharp mean bounds hold simultaneously for every band above it. -/ theorem exists_dyadicPrimeBand_mean_cutoff {lam : ℝ} (hlam : 1 ≤ lam) (hcritical : 1 < lam * log 2) : ∃ A0 : ℝ, 0 < A0 ∧ ∀ A : ℝ, A0 ≤ A → ∀ j : ℕ, (lam * log 2 + 1) / 2 ≤ (∑ p ∈ dyadicPrimeBand A j, primeTiltSelectionProbability lam p) ∧ (∑ p ∈ dyadicPrimeBand A j, primeTiltSelectionProbability lam p) ≤ lam * log 2 + 1 := by obtain ⟨a0, ha0⟩ := eventually_atTop.mp (eventually_primeLogWindow_tilt_mean_bounds hlam hcritical) refine ⟨max a0 1, lt_of_lt_of_le (by norm_num : (0 : ℝ) < 1) (le_max_right _ _), ?_⟩ intro A hA j have hA0 : 0 ≤ A := (by norm_num : (0 : ℝ) ≤ 1).trans ((le_max_right _ _).trans hA) have hbase : a0 ≤ A * (2 : ℝ) ^ j := by calc a0 ≤ A := (le_max_left _ _).trans hA _ = A * 1 := by ring _ ≤ _ := mul_le_mul_of_nonneg_left (one_le_pow₀ (by norm_num : (1 : ℝ) ≤ 2)) hA0 exact ha0 _ hbase /-- Every supercritical prime tilt has a fixed reverse-count speed above one. The same offset and cutoff work for all finite numbers of bands and for any larger ambient prime universe. -/ theorem exists_dyadic_prime_reverse_barrier {lam err : ℝ} (hcritical : 1 < lam * log 2) (herr : 0 < err) : ∃ v : ℝ, 1 < v ∧ ∃ D : ℕ, ∃ A0 : ℝ, 0 < A0 ∧ ∀ A : ℝ, A0 ≤ A → ∀ k : ℕ, ∀ P : Finset ℕ, (∀ p ∈ P, p.Prime) → dyadicPrimeUniverse A k ⊆ P → (∑ T ∈ P.powerset.filter (ReverseCountBarrierFailure k v D (dyadicPrimeTail A k)), primeTiltWeight P lam T) ≤ err := by have hlog0 : 0 < log (2 : ℝ) := log_pos (by norm_num) have hlog1 : log (2 : ℝ) < 1 := by have h := log_lt_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) (by norm_num : (2 : ℝ) ≠ 1) linarith have hlam : 1 ≤ lam := by by_contra h have hm := mul_lt_mul_of_pos_right (lt_of_not_ge h) hlog0 linarith let mu : ℝ := (lam * log 2 + 1) / 2 let v : ℝ := (lam * log 2 + 3) / 4 have hv : 1 < v := by dsimp [v]; linarith have hvm : v < mu := by dsimp [v, mu]; linarith obtain ⟨D, hD⟩ := exists_uniform_reverse_count_barrier (zero_lt_one.trans hv) hvm herr obtain ⟨A0, hA0, hmeans⟩ := exists_dyadicPrimeBand_mean_cutoff hlam hcritical refine ⟨v, hv, D, A0, hA0, ?_⟩ intro A hA k P hP hUP apply hD P lam hP (zero_lt_one.trans_le hlam) k (dyadicPrimeTail A k) · intro ell _ exact (dyadicPrimeTail_subset_universe A k ell).trans hUP · intro ell hell exact dyadicPrimeTail_mean_lower (hA0.trans_le hA) hell (fun j _ ↦ (hmeans A hA j).1) end Erdos859Verification end /- Inlined development module: SubsetSumSmoothing.lean -/ section /- Fair subset sums connect the finite collision and smoothing estimates. -/ open Finset Real MeasureTheory namespace Erdos859Verification noncomputable def finiteSubsetSumAtom {ι : Type*} [Fintype ι] {α : ι → Type*} (mark : ∀ i, α i → ℝ) (x : ∀ i, α i) (b : ι → Bool) : ℝ := ∑ i, if b i then mark i (x i) else 0 theorem finiteSubsetSumAtom_sub {ι : Type*} [Fintype ι] {α : ι → Type*} (mark : ∀ i, α i → ℝ) (x : ∀ i, α i) (b b' : ι → Bool) : finiteSubsetSumAtom mark x b - finiteSubsetSumAtom mark x b' = ∑ i, fairBitDifference (b i) (b' i) * mark i (x i) := by unfold finiteSubsetSumAtom rw [← sum_sub_distrib] apply sum_congr rfl intro i _ cases b i <;> cases b' i <;> simp [fairBitDifference] noncomputable def finiteSubsetSumEnergy {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} (mark : ∀ i, α i → ℝ) (x : ∀ i, α i) (d : ℝ) : ℝ := ∫ y, finiteIntervalSmoothing (fun _b : ι → Bool ↦ fairBitWeight ι) (finiteSubsetSumAtom mark x) d y ^ 2 theorem finiteSubsetSumEnergy_nonneg {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} (mark : ∀ i, α i → ℝ) (x : ∀ i, α i) (d : ℝ) : 0 ≤ finiteSubsetSumEnergy mark x d := integral_nonneg (fun _ ↦ sq_nonneg _) theorem finiteSubsetSumEnergy_le_collision {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} (mark : ∀ i, α i → ℝ) (x : ∀ i, α i) {d : ℝ} (hd : 0 < d) : finiteSubsetSumEnergy mark x d ≤ fairBitPairMean (fun b b' ↦ if |∑ i, fairBitDifference (b i) (b' i) * mark i (x i)| ≤ d then 1 else 0) / d := by simpa only [finiteSubsetSumEnergy, finiteSubsetSumAtom_sub, fairBitPairMean] using integral_finiteIntervalSmoothing_sq_le_collision (fun _b : ι → Bool ↦ fairBitWeight ι) (finiteSubsetSumAtom mark x) hd (fun _ ↦ fairBitWeight_nonneg ι) theorem finiteSubsetSumEnergy_expectation_le_collision {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} [∀ i, Fintype (α i)] (w mark : ∀ i, α i → ℝ) {d : ℝ} (hd : 0 < d) (hw : ∀ i y, 0 ≤ w i y) : (∑ x : ∀ i, α i, finiteProductWeight w x * finiteSubsetSumEnergy mark x d) ≤ finiteSubsetSumCollision w mark d / d := by classical calc _ ≤ ∑ x : ∀ i, α i, finiteProductWeight w x * (fairBitPairMean (fun b b' ↦ if |∑ i, fairBitDifference (b i) (b' i) * mark i (x i)| ≤ d then 1 else 0) / d) := sum_le_sum (fun x _ ↦ mul_le_mul_of_nonneg_left (finiteSubsetSumEnergy_le_collision mark x hd) (finiteProductWeight_nonneg hw x)) _ = finiteSubsetSumCollision w mark d / d := by unfold finiteSubsetSumCollision rw [fairBitPairMean_sum] simp only [fairBitPairMean_const_mul, sum_div, mul_div_assoc] theorem finiteSubsetSum_support_energy {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} (mark : ∀ i, α i → ℝ) (x : ∀ i, α i) {d : ℝ} (hd : 0 < d) : 1 ≤ volume.real (finiteIntervalSupport (finiteSubsetSumAtom mark x) d) * finiteSubsetSumEnergy mark x d := finiteIntervalSmoothing_support_measure (fun _b : ι → Bool ↦ fairBitWeight ι) (finiteSubsetSumAtom mark x) hd (fun _ ↦ fairBitWeight_nonneg ι) (sum_fairBitWeight ι) /-- The smoothed fair subset-sum law of independent reciprocal prime marks has expected energy at most a fixed constant divided by the top log scale. -/ theorem dyadicPrimeMark_expected_energy_bound {ι : Type*} [Fintype ι] [DecidableEq ι] {k : ℕ} (band : ι → Fin k) {A b d eps D : ℝ} (ha : log 2 ≤ A) (hlarge : 4 * mertensErrorConstant ≤ A * log 2) (hb : 0 < b) (hd : 1 ≤ d) (hscale : b * A ≤ d) (heps : 0 < eps) (hbarrier : ∀ j : Fin k, (1 + eps) * ((k - 1 - j.val : ℕ) : ℝ) - D ≤ ((univ.filter (fun i ↦ j < band i)).card : ℝ)) (htotal : (k : ℝ) - D ≤ Fintype.card ι) : (∑ x : ∀ i, DyadicPrimeMark A (band i).val, finiteProductWeight (fun i ↦ dyadicPrimeMarkWeight A (band i).val) x * finiteSubsetSumEnergy (fun i (p : DyadicPrimeMark A (band i).val) ↦ log (p : ℕ)) x d) ≤ ((2 : ℝ) ^ D / b + 2 * primeLogCollisionConstant * (2 : ℝ) ^ (D + 1) / (1 - (2 : ℝ) ^ (-eps))) / (A * (2 : ℝ) ^ k) := by exact (finiteSubsetSumEnergy_expectation_le_collision _ _ (zero_lt_one.trans_le hd) (fun i ↦ (dyadicPrimeMarkWeight_normalized ha hlarge (band i).val).1)).trans (dyadicPrimeMark_collision_energy_bound band ha hlarge hb hd hscale heps hbarrier htotal) end Erdos859Verification end /- Inlined development module: FiniteSupportProbability.lean -/ section /- Finite probability bounds for the measure of a smoothed support. -/ open Finset MeasureTheory namespace Erdos859Verification /-- A support smaller than the reciprocal threshold forces a large energy. -/ theorem energy_large_of_support_small {V E t : ℝ} (hV : 0 ≤ V) (ht : 0 < t) (hVE : 1 ≤ V * E) (hsmall : V < 1 / t) : t ≤ E := by by_contra hE have hEt : E ≤ t := (lt_of_not_ge hE).le have hprod : V * E ≤ V * t := mul_le_mul_of_nonneg_left hEt hV have hstrict : V * t < 1 := (lt_div_iff₀ ht).mp hsmall linarith /-- A finite weighted Markov bound, combined with `1 ≤ size * energy`. The ambient weights need not be normalized, so this also applies on a restricted good-configuration event. -/ theorem finite_support_bad_weight_le {β : Type*} (S : Finset β) (W E V : β → ℝ) {L R : ℝ} (hL : 0 < L) (hR : 0 < R) (hW : ∀ b ∈ S, 0 ≤ W b) (hE : ∀ b ∈ S, 0 ≤ E b) (hV : ∀ b ∈ S, 0 ≤ V b) (hVE : ∀ b ∈ S, 1 ≤ V b * E b) (haverage : (∑ b ∈ S, W b * E b) ≤ R) : (∑ b ∈ S with V b < 1 / (L * R), W b) ≤ 1 / L := by classical have hLR : 0 < L * R := mul_pos hL hR have hsub : (S.filter (fun b ↦ V b < 1 / (L * R))) ⊆ S.filter (fun b ↦ L * R ≤ E b) := by intro b hb obtain ⟨hbS, hbsmall⟩ := mem_filter.mp hb exact mem_filter.mpr ⟨hbS, energy_large_of_support_small (hV b hbS) hLR (hVE b hbS) hbsmall⟩ calc _ ≤ ∑ b ∈ S with L * R ≤ E b, W b := sum_le_sum_of_subset_of_nonneg hsub (fun b hb _ ↦ hW b (mem_filter.mp hb).1) _ ≤ (∑ b ∈ S, W b * E b) / (L * R) := finite_weighted_markov S W E hLR hW hE _ ≤ R / (L * R) := div_le_div_of_nonneg_right haverage hLR.le _ = 1 / L := by field_simp [hL.ne', hR.ne'] /-- The large-support event retains all ambient mass apart from `1/L`. -/ theorem finite_support_good_weight_ge_mass {β : Type*} (S : Finset β) (W E V : β → ℝ) {L R : ℝ} (hL : 0 < L) (hR : 0 < R) (hW : ∀ b ∈ S, 0 ≤ W b) (hE : ∀ b ∈ S, 0 ≤ E b) (hV : ∀ b ∈ S, 0 ≤ V b) (hVE : ∀ b ∈ S, 1 ≤ V b * E b) (haverage : (∑ b ∈ S, W b * E b) ≤ R) : (∑ b ∈ S, W b) - 1 / L ≤ ∑ b ∈ S with 1 / (L * R) ≤ V b, W b := by classical have hbad := finite_support_bad_weight_le S W E V hL hR hW hE hV hVE haverage have hsplit := sum_filter_add_sum_filter_not S (fun b ↦ V b < 1 / (L * R)) W simp only [not_lt] at hsplit linarith theorem finite_support_good_weight_ge {β : Type*} (S : Finset β) (W E V : β → ℝ) {L R : ℝ} (hL : 0 < L) (hR : 0 < R) (hW : ∀ b ∈ S, 0 ≤ W b) (hE : ∀ b ∈ S, 0 ≤ E b) (hV : ∀ b ∈ S, 0 ≤ V b) (hVE : ∀ b ∈ S, 1 ≤ V b * E b) (hnorm : ∑ b ∈ S, W b = 1) (haverage : (∑ b ∈ S, W b * E b) ≤ R) : 1 - 1 / L ≤ ∑ b ∈ S with 1 / (L * R) ≤ V b, W b := by simpa only [hnorm] using finite_support_good_weight_ge_mass S W E V hL hR hW hE hV hVE haverage /-- Small thickened supports are rare when the mean interval-smoothing energy is small. The finite atom type may depend on the configuration. -/ theorem finiteIntervalSupport_bad_weight_le {β : Type*} [Fintype β] {α : β → Type*} [∀ b, Fintype (α b)] (W : β → ℝ) (w atom : ∀ b, α b → ℝ) {d L R : ℝ} (hd : 0 < d) (hL : 0 < L) (hR : 0 < R) (hW : ∀ b, 0 ≤ W b) (hw : ∀ b i, 0 ≤ w b i) (hnorm : ∀ b, ∑ i, w b i = 1) (haverage : (∑ b, W b * (∫ y, finiteIntervalSmoothing (w b) (atom b) d y ^ 2)) ≤ R) : (∑ b : β with volume.real (finiteIntervalSupport (atom b) d) < 1 / (L * R), W b) ≤ 1 / L := by classical exact finite_support_bad_weight_le univ W (fun b ↦ ∫ y, finiteIntervalSmoothing (w b) (atom b) d y ^ 2) (fun b ↦ volume.real (finiteIntervalSupport (atom b) d)) hL hR (fun b _ ↦ hW b) (fun _ _ ↦ integral_nonneg (fun _ ↦ sq_nonneg _)) (fun _ _ ↦ measureReal_nonneg) (fun b _ ↦ finiteIntervalSmoothing_support_measure (w b) (atom b) hd (hw b) (hnorm b)) haverage /-- With normalized configuration weights, a support of measure at least `1/(L*R)` occurs with weight at least `1 - 1/L`. -/ theorem finiteIntervalSupport_good_weight_ge {β : Type*} [Fintype β] {α : β → Type*} [∀ b, Fintype (α b)] (W : β → ℝ) (w atom : ∀ b, α b → ℝ) {d L R : ℝ} (hd : 0 < d) (hL : 0 < L) (hR : 0 < R) (hW : ∀ b, 0 ≤ W b) (hWnorm : ∑ b, W b = 1) (hw : ∀ b i, 0 ≤ w b i) (hnorm : ∀ b, ∑ i, w b i = 1) (haverage : (∑ b, W b * (∫ y, finiteIntervalSmoothing (w b) (atom b) d y ^ 2)) ≤ R) : 1 - 1 / L ≤ ∑ b : β with 1 / (L * R) ≤ volume.real (finiteIntervalSupport (atom b) d), W b := by classical exact finite_support_good_weight_ge univ W (fun b ↦ ∫ y, finiteIntervalSmoothing (w b) (atom b) d y ^ 2) (fun b ↦ volume.real (finiteIntervalSupport (atom b) d)) hL hR (fun b _ ↦ hW b) (fun _ _ ↦ integral_nonneg (fun _ ↦ sq_nonneg _)) (fun _ _ ↦ measureReal_nonneg) (fun b _ ↦ finiteIntervalSmoothing_support_measure (w b) (atom b) hd (hw b) (hnorm b)) hWnorm haverage end Erdos859Verification end /- Inlined development module: PrimeDyadicGoodCounts.lean -/ section /- Joint count regularity, reverse barriers, and logarithmic support bounds. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification theorem finite_weighted_or_le (S : Finset (Finset ℕ)) (w : Finset ℕ → ℝ) (hw : ∀ T ∈ S, 0 ≤ w T) (F G : Finset ℕ → Prop) [DecidablePred F] [DecidablePred G] : (∑ T ∈ S with F T ∨ G T, w T) ≤ (∑ T ∈ S with F T, w T) + ∑ T ∈ S with G T, w T := by simp only [sum_filter, ← sum_add_distrib] apply sum_le_sum intro T hT by_cases hF : F T <;> by_cases hG : G T <;> simp [hF, hG, hw T hT] /-- The sum of the logarithms of all selected primes in the dyadic bands. -/ noncomputable def dyadicSelectedLogSum (A : ℝ) (k : ℕ) (T : Finset ℕ) : ℝ := ∑ p ∈ T ∩ dyadicPrimeUniverse A k, log (p : ℝ) theorem dyadicSelectedLogSum_nonneg (A : ℝ) (k : ℕ) (T : Finset ℕ) : 0 ≤ dyadicSelectedLogSum A k T := by apply sum_nonneg intro p hp have hpprime := dyadicPrimeUniverse_prime A k p (Finset.mem_inter.mp hp).2 apply log_nonneg exact_mod_cast hpprime.one_lt.le theorem dyadicSelectedLogSum_le {A : ℝ} (hA : 0 < A) (k : ℕ) (T : Finset ℕ) : dyadicSelectedLogSum A k T ≤ ∑ j ∈ range k, ((T ∩ dyadicPrimeBand A j).card : ℝ) * (2 * A * (2 : ℝ) ^ j) := by have heq : T ∩ dyadicPrimeUniverse A k = (range k).biUnion (fun j ↦ T ∩ dyadicPrimeBand A j) := by ext p simp only [dyadicPrimeUniverse, Finset.mem_inter, Finset.mem_biUnion] aesop unfold dyadicSelectedLogSum rw [heq, sum_biUnion] · apply sum_le_sum intro j _ calc _ ≤ ∑ _p ∈ T ∩ dyadicPrimeBand A j, (2 * A * (2 : ℝ) ^ j) := by apply sum_le_sum intro p hp simpa only [mul_assoc] using (mem_dyadicPrimeBand.mp (Finset.mem_inter.mp hp).2).2.2 _ = _ := by simp · intro i _ j _ hij exact (dyadicPrimeBand_pairwise_disjoint hA hij).mono inter_subset_right inter_subset_right /-- Uniform band means bound the full selected logarithmic sum by a constant times the terminal logarithmic scale. -/ theorem dyadicSelectedLogSum_expectation_le {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam A M : ℝ} (hlam : 0 < lam) (hA : 0 < A) (hM : 0 ≤ M) (k : ℕ) (hUP : dyadicPrimeUniverse A k ⊆ P) (hmean : ∀ j < k, (∑ p ∈ dyadicPrimeBand A j, primeTiltSelectionProbability lam p) ≤ M) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * dyadicSelectedLogSum A k T) ≤ 2 * M * A * (2 : ℝ) ^ k := by have hpow : (∑ j ∈ range k, (2 : ℝ) ^ j) = 2 ^ k - 1 := by clear hUP hmean induction k with | zero => simp | succ k ih => rw [sum_range_succ, ih, pow_succ]; ring calc _ ≤ ∑ T ∈ P.powerset, primeTiltWeight P lam T * (∑ j ∈ range k, ((T ∩ dyadicPrimeBand A j).card : ℝ) * (2 * A * (2 : ℝ) ^ j)) := by apply sum_le_sum intro T _ exact mul_le_mul_of_nonneg_left (dyadicSelectedLogSum_le hA k T) (primeTiltWeight_pos hP hlam T).le _ = ∑ j ∈ range k, (∑ T ∈ P.powerset, primeTiltWeight P lam T * ((T ∩ dyadicPrimeBand A j).card : ℝ)) * (2 * A * (2 : ℝ) ^ j) := by simp only [mul_sum] rw [sum_comm] apply sum_congr rfl intro j _ rw [sum_mul] apply sum_congr rfl intro T _ ring _ ≤ ∑ j ∈ range k, M * (2 * A * (2 : ℝ) ^ j) := by apply sum_le_sum intro j hj rw [primeTiltWeight_restricted_count_mean hP ((dyadicPrimeBand_subset_universe (Finset.mem_range.mp hj)).trans hUP) hlam] exact mul_le_mul_of_nonneg_right (hmean j (Finset.mem_range.mp hj)) (by positivity) _ = 2 * M * A * ((2 : ℝ) ^ k - 1) := by rw [← hpow, mul_sum] apply sum_congr rfl intro j _ ring _ ≤ _ := mul_le_mul_of_nonneg_left (sub_le_self _ (by norm_num)) (by positivity) theorem dyadicSelectedLogSum_bad_weight_le {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam A M err : ℝ} (hlam : 0 < lam) (hA : 0 < A) (hM : 0 < M) (herr : 0 < err) (k : ℕ) (hUP : dyadicPrimeUniverse A k ⊆ P) (hmean : ∀ j < k, (∑ p ∈ dyadicPrimeBand A j, primeTiltSelectionProbability lam p) ≤ M) : (∑ T ∈ P.powerset with (2 * M / err) * (A * (2 : ℝ) ^ k) ≤ dyadicSelectedLogSum A k T, primeTiltWeight P lam T) ≤ err := by have hthreshold : 0 < (2 * M / err) * (A * (2 : ℝ) ^ k) := by positivity calc _ ≤ (∑ T ∈ P.powerset, primeTiltWeight P lam T * dyadicSelectedLogSum A k T) / ((2 * M / err) * (A * (2 : ℝ) ^ k)) := finite_weighted_markov P.powerset (primeTiltWeight P lam) (dyadicSelectedLogSum A k) hthreshold (fun T _ ↦ (primeTiltWeight_pos hP hlam T).le) (fun T _ ↦ dyadicSelectedLogSum_nonneg A k T) _ ≤ (2 * M * A * (2 : ℝ) ^ k) / ((2 * M / err) * (A * (2 : ℝ) ^ k)) := div_le_div_of_nonneg_right (dyadicSelectedLogSum_expectation_le hP hlam hA hM.le k hUP hmean) hthreshold.le _ = err := by field_simp abbrev DyadicCountFailure (A : ℝ) (k : ℕ) (v r0 : ℝ) (D : ℕ) (T : Finset ℕ) : Prop := ReverseCountBarrierFailure k v D (dyadicPrimeTail A k) T ∨ r0 ≤ primeCountRegularity A k (dyadicPrimeBand A) T abbrev DyadicGoodCounts (A : ℝ) (k : ℕ) (v r0 C : ℝ) (D : ℕ) (T : Finset ℕ) : Prop := ¬ DyadicCountFailure A k v r0 D T ∧ dyadicSelectedLogSum A k T < C * (A * (2 : ℝ) ^ k) /-- One choice of parameters simultaneously enforces reverse count growth, quadratic count regularity, and an upper bound on the selected logarithmic sum. The count failures cost at most `2 * err`; all three failures cost at most `3 * err`, uniformly in the number of bands and the ambient prime universe. -/ theorem exists_dyadic_good_count_parameters {lam r0 err : ℝ} (hcritical : 1 < lam * log 2) (hr0 : 0 < r0) (herr : 0 < err) : ∃ v : ℝ, 1 < v ∧ ∃ D : ℕ, ∃ A0 : ℝ, 0 < A0 ∧ ∀ A : ℝ, A0 ≤ A → ∀ k : ℕ, ∀ P : Finset ℕ, (∀ p ∈ P, p.Prime) → dyadicPrimeUniverse A k ⊆ P → ((∑ T ∈ P.powerset.filter (DyadicCountFailure A k v r0 D), primeTiltWeight P lam T) ≤ 2 * err) ∧ 1 - 3 * err ≤ ∑ T ∈ P.powerset.filter (DyadicGoodCounts A k v r0 (2 * (lam * log 2 + 1) / err) D), primeTiltWeight P lam T := by have hlog0 : 0 < log (2 : ℝ) := log_pos (by norm_num) have hlog1 : log (2 : ℝ) < 1 := by have h := log_lt_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) (by norm_num : (2 : ℝ) ≠ 1) linarith have hlam : 1 ≤ lam := by by_contra h have hm := mul_lt_mul_of_pos_right (lt_of_not_ge h) hlog0 linarith have hlam0 : 0 < lam := zero_lt_one.trans_le hlam let M : ℝ := lam * log 2 + 1 have hM : 0 < M := by dsimp [M]; linarith obtain ⟨v, hv, D, Abar, hAbar, hbar⟩ := exists_dyadic_prime_reverse_barrier hcritical herr obtain ⟨Amean, hAmean, hmean⟩ := exists_dyadicPrimeBand_mean_cutoff hlam hcritical obtain ⟨Areg, hAreg, hreg⟩ := exists_uniform_primeCountRegularity_cutoff hM.le hr0 herr refine ⟨v, hv, D, max Abar (max Amean Areg), hAbar.trans_le (le_max_left _ _), ?_⟩ intro A hA k P hP hUP have hAbar' : Abar ≤ A := (le_max_left _ _).trans hA have hAmean' : Amean ≤ A := (le_max_left _ _).trans ((le_max_right _ _).trans hA) have hAreg' : Areg ≤ A := (le_max_right _ _).trans ((le_max_right _ _).trans hA) have hApos : 0 < A := hAbar.trans_le hAbar' have hbands : ∀ j < k, dyadicPrimeBand A j ⊆ P := fun j hj ↦ (dyadicPrimeBand_subset_universe hj).trans hUP have hmeans : ∀ j < k, (∑ p ∈ dyadicPrimeBand A j, primeTiltSelectionProbability lam p) ≤ M := fun j _ ↦ (hmean A hAmean' j).2 have hc : (∑ T ∈ P.powerset.filter (DyadicCountFailure A k v r0 D), primeTiltWeight P lam T) ≤ 2 * err := by have hu := finite_weighted_or_le P.powerset (primeTiltWeight P lam) (fun T _ ↦ (primeTiltWeight_pos hP hlam0 T).le) (ReverseCountBarrierFailure k v D (dyadicPrimeTail A k)) (fun T ↦ r0 ≤ primeCountRegularity A k (dyadicPrimeBand A) T) have hb := hbar A hAbar' k P hP hUP have hr := hreg A hAreg' P lam hP hlam0 k (dyadicPrimeBand A) hbands hmeans exact hu.trans (by linarith) refine ⟨hc, ?_⟩ let L : Finset ℕ → Prop := fun T ↦ (2 * M / err) * (A * (2 : ℝ) ^ k) ≤ dyadicSelectedLogSum A k T have hl : (∑ T ∈ P.powerset.filter L, primeTiltWeight P lam T) ≤ err := dyadicSelectedLogSum_bad_weight_le hP hlam0 hApos hM herr k hUP hmeans have hbad : (∑ T ∈ P.powerset with DyadicCountFailure A k v r0 D T ∨ L T, primeTiltWeight P lam T) ≤ 3 * err := by have hu := finite_weighted_or_le P.powerset (primeTiltWeight P lam) (fun T _ ↦ (primeTiltWeight_pos hP hlam0 T).le) (DyadicCountFailure A k v r0 D) L exact hu.trans (by linarith) have htotal := sum_filter_add_sum_filter_not P.powerset (fun T ↦ DyadicCountFailure A k v r0 D T ∨ L T) (primeTiltWeight P lam) rw [sum_primeTiltWeight hP hlam0] at htotal have hgood : (∑ T ∈ P.powerset with ¬ (DyadicCountFailure A k v r0 D T ∨ L T), primeTiltWeight P lam T) = ∑ T ∈ P.powerset.filter (DyadicGoodCounts A k v r0 (2 * (lam * log 2 + 1) / err) D), primeTiltWeight P lam T := by simp only [L, M, not_or, not_le, DyadicGoodCounts] rw [hgood] at htotal linarith end Erdos859Verification end /- Inlined development module: DyadicPrimeSupport.lean -/ section /- Positive thickened subset-sum support for independent prime marks. -/ open Finset Real MeasureTheory namespace Erdos859Verification noncomputable def dyadicPrimeEnergyConstant (b eps D : ℝ) : ℝ := (2 : ℝ) ^ D / b + 2 * primeLogCollisionConstant * (2 : ℝ) ^ (D + 1) / (1 - (2 : ℝ) ^ (-eps)) theorem dyadicPrimeEnergyConstant_pos {b eps D : ℝ} (hb : 0 < b) (heps : 0 < eps) : 0 < dyadicPrimeEnergyConstant b eps D := by have hq : 0 < 1 - (2 : ℝ) ^ (-eps) := sub_pos.mpr (rpow_lt_one_of_one_lt_of_neg (by norm_num) (neg_neg_of_pos heps)) unfold dyadicPrimeEnergyConstant positivity [primeLogCollisionConstant_pos] /-- Under a reverse-count barrier, at least half the iid prime-mark weight has thickened subset-sum support of measure comparable to the top log scale. -/ theorem dyadicPrimeMark_positive_support {ι : Type*} [Fintype ι] [DecidableEq ι] {k : ℕ} (band : ι → Fin k) {A b d eps D : ℝ} (ha : log 2 ≤ A) (hlarge : 4 * mertensErrorConstant ≤ A * log 2) (hb : 0 < b) (hd : 1 ≤ d) (hscale : b * A ≤ d) (heps : 0 < eps) (hbarrier : ∀ j : Fin k, (1 + eps) * ((k - 1 - j.val : ℕ) : ℝ) - D ≤ ((univ.filter (fun i ↦ j < band i)).card : ℝ)) (htotal : (k : ℝ) - D ≤ Fintype.card ι) : (1 : ℝ) / 2 ≤ ∑ x : ∀ i, DyadicPrimeMark A (band i).val with (A * (2 : ℝ) ^ k) / (2 * dyadicPrimeEnergyConstant b eps D) ≤ volume.real (finiteIntervalSupport (finiteSubsetSumAtom (fun i (p : DyadicPrimeMark A (band i).val) ↦ log (p : ℕ)) x) d), finiteProductWeight (fun i ↦ dyadicPrimeMarkWeight A (band i).val) x := by classical let mark := fun i (p : DyadicPrimeMark A (band i).val) ↦ log (p : ℕ) let w := fun i ↦ dyadicPrimeMarkWeight A (band i).val let X : ℝ := A * (2 : ℝ) ^ k let C : ℝ := dyadicPrimeEnergyConstant b eps D have hX : 0 < X := by dsimp [X] positivity [(log_pos (by norm_num : (1 : ℝ) < 2)).trans_le ha] have hC : 0 < C := dyadicPrimeEnergyConstant_pos hb heps have hW : ∀ x : ∀ i, DyadicPrimeMark A (band i).val, 0 ≤ finiteProductWeight w x := finiteProductWeight_nonneg (fun i ↦ (dyadicPrimeMarkWeight_normalized ha hlarge (band i).val).1) have hnorm : (∑ x : ∀ i, DyadicPrimeMark A (band i).val, finiteProductWeight w x) = 1 := sum_finiteProductWeight w (fun i ↦ (dyadicPrimeMarkWeight_normalized ha hlarge (band i).val).2) have henergy : (∑ x : ∀ i, DyadicPrimeMark A (band i).val, finiteProductWeight w x * finiteSubsetSumEnergy mark x d) ≤ C / X := dyadicPrimeMark_expected_energy_bound band ha hlarge hb hd hscale heps hbarrier htotal have hgood := finite_support_good_weight_ge univ (finiteProductWeight w) (fun x ↦ finiteSubsetSumEnergy mark x d) (fun x ↦ volume.real (finiteIntervalSupport (finiteSubsetSumAtom mark x) d)) (show (0 : ℝ) < 2 by norm_num) (div_pos hC hX) (fun x _ ↦ hW x) (fun x _ ↦ finiteSubsetSumEnergy_nonneg mark x d) (fun _ _ ↦ measureReal_nonneg) (fun x _ ↦ finiteSubsetSum_support_energy mark x (zero_lt_one.trans_le hd)) hnorm henergy have hthreshold : 1 / (2 * (C / X)) = X / (2 * C) := by field_simp norm_num only [hthreshold] at hgood exact hgood theorem finiteSubsetSumAtom_nonneg {ι : Type*} [Fintype ι] {α : ι → Type*} (mark : ∀ i, α i → ℝ) (x : ∀ i, α i) (hmark : ∀ i, 0 ≤ mark i (x i)) (b : ι → Bool) : 0 ≤ finiteSubsetSumAtom mark x b := by apply sum_nonneg intro i _ split_ifs · exact hmark i · exact le_rfl theorem finiteSubsetSumAtom_le_total {ι : Type*} [Fintype ι] {α : ι → Type*} (mark : ∀ i, α i → ℝ) (x : ∀ i, α i) (hmark : ∀ i, 0 ≤ mark i (x i)) (b : ι → Bool) : finiteSubsetSumAtom mark x b ≤ ∑ i, mark i (x i) := by apply sum_le_sum intro i _ split_ifs · exact le_rfl · exact hmark i theorem finiteSubsetSumSupport_subset_Icc {ι : Type*} [Fintype ι] {α : ι → Type*} (mark : ∀ i, α i → ℝ) (x : ∀ i, α i) (hmark : ∀ i, 0 ≤ mark i (x i)) (d : ℝ) : finiteIntervalSupport (finiteSubsetSumAtom mark x) d ⊆ Set.Icc 0 ((∑ i, mark i (x i)) + d) := finiteIntervalSupport_subset_Icc _ d 0 _ (finiteSubsetSumAtom_nonneg mark x hmark) (fun b ↦ add_le_add (finiteSubsetSumAtom_le_total mark x hmark b) le_rfl) end Erdos859Verification end /- Inlined development module: PrimePartitionLaw.lean -/ section /- Exact factorization of the selected-prime law over disjoint finite bands. -/ open Finset namespace Erdos859Verification def primeBandUnion {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) : Finset ℕ := univ.biUnion P def primeBandSelections {ι : Type*} [Fintype ι] [DecidableEq ι] (P : ι → Finset ℕ) : Finset (ι → Finset ℕ) := Fintype.piFinset (fun j ↦ (P j).powerset) theorem mem_primeBandSelections {ι : Type*} [Fintype ι] [DecidableEq ι] {P : ι → Finset ℕ} {U : ι → Finset ℕ} : U ∈ primeBandSelections P ↔ ∀ j, U j ⊆ P j := by simp [primeBandSelections] theorem primeBand_intersections_union {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) {T : Finset ℕ} (hT : T ⊆ primeBandUnion P) : univ.biUnion (fun j ↦ T ∩ P j) = T := by ext p constructor · intro hp obtain ⟨j, _, hj⟩ := mem_biUnion.mp hp exact (mem_inter.mp hj).1 · intro hp obtain ⟨j, hj, hpj⟩ := mem_biUnion.mp (hT hp) exact mem_biUnion.mpr ⟨j, hj, mem_inter.mpr ⟨hp, hpj⟩⟩ theorem primeBand_union_subset {ι : Type*} [Fintype ι] {P U : ι → Finset ℕ} (hU : ∀ j, U j ⊆ P j) : univ.biUnion U ⊆ primeBandUnion P := by intro p hp obtain ⟨j, hj, hpj⟩ := mem_biUnion.mp hp exact mem_biUnion.mpr ⟨j, hj, hU j hpj⟩ theorem primeBand_union_inter {ι : Type*} [Fintype ι] {P U : ι → Finset ℕ} (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) (hU : ∀ j, U j ⊆ P j) (j : ι) : univ.biUnion U ∩ P j = U j := by classical ext p constructor · intro hp obtain ⟨hpU, hpP⟩ := mem_inter.mp hp obtain ⟨i, _, hpi⟩ := mem_biUnion.mp hpU have hij : i = j := by by_contra hne exact disjoint_left.mp (hdis hne) (hU i hpi) hpP subst i exact hpi · intro hp exact mem_inter.mpr ⟨mem_biUnion.mpr ⟨j, mem_univ j, hp⟩, hU j hp⟩ /-- Intersection with the bands and union of band selections are inverse reindexings of the two finite configuration spaces. -/ theorem sum_powerset_primeBand_partition {ι : Type*} [Fintype ι] [DecidableEq ι] (P : ι → Finset ℕ) (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) (F : (ι → Finset ℕ) → ℝ) : (∑ T ∈ (primeBandUnion P).powerset, F (fun j ↦ T ∩ P j)) = ∑ U ∈ primeBandSelections P, F U := by classical apply sum_bij (fun T _ ↦ fun j ↦ T ∩ P j) · intro T _ exact mem_primeBandSelections.mpr (fun _ ↦ inter_subset_right) · intro S hS T hT heq have hu := congrArg (fun U : ι → Finset ℕ ↦ univ.biUnion U) heq simpa only [primeBand_intersections_union P (mem_powerset.mp hS), primeBand_intersections_union P (mem_powerset.mp hT)] using hu · intro U hU have hsub := mem_primeBandSelections.mp hU refine ⟨univ.biUnion U, mem_powerset.mpr (primeBand_union_subset hsub), ?_⟩ funext j exact primeBand_union_inter hdis hsub j · intro T _ rfl theorem primePatternWeight_primeBand_partition {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) (T : Finset ℕ) : primePatternWeight (primeBandUnion P) T = ∏ j, primePatternWeight (P j) (T ∩ P j) := by unfold primePatternWeight primeBandUnion rw [prod_biUnion (fun i _ j _ hij ↦ hdis hij)] apply prod_congr rfl intro j _ apply prod_congr rfl intro p hp simp [hp] theorem primeTiltNormalizer_primeBand_partition {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) (lam : ℝ) : primeTiltNormalizer (primeBandUnion P) lam = ∏ j, primeTiltNormalizer (P j) lam := by exact prod_biUnion (fun i _ j _ hij ↦ hdis hij) theorem card_primeBand_intersections {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) {T : Finset ℕ} (hT : T ⊆ primeBandUnion P) : T.card = ∑ j, (T ∩ P j).card := by calc T.card = (univ.biUnion (fun j ↦ T ∩ P j)).card := congrArg Finset.card (primeBand_intersections_union P hT).symm _ = _ := card_biUnion (fun i _ j _ hij ↦ Disjoint.mono inter_subset_right inter_subset_right (hdis hij)) /-- The exact tilted weight factors over a disjoint band partition. This identity is algebraic and needs no primality or positivity hypotheses. -/ theorem primeTiltWeight_primeBand_partition {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) {T : Finset ℕ} (hT : T ⊆ primeBandUnion P) (lam : ℝ) : primeTiltWeight (primeBandUnion P) lam T = ∏ j, primeTiltWeight (P j) lam (T ∩ P j) := by simp only [primeTiltWeight, prod_div_distrib, prod_mul_distrib] rw [primePatternWeight_primeBand_partition P hdis, primeTiltNormalizer_primeBand_partition P hdis, card_primeBand_intersections P hdis hT, prod_pow_eq_pow_sum] /-- The ambient selected-prime law is exactly the product of the per-band laws, for every observable of the vector of band intersections. -/ theorem prime_tilt_expectation_primeBand_partition {ι : Type*} [Fintype ι] [DecidableEq ι] (P : ι → Finset ℕ) (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) (lam : ℝ) (F : (ι → Finset ℕ) → ℝ) : (∑ T ∈ (primeBandUnion P).powerset, primeTiltWeight (primeBandUnion P) lam T * F (fun j ↦ T ∩ P j)) = ∑ U ∈ primeBandSelections P, (∏ j, primeTiltWeight (P j) lam (U j)) * F U := by calc _ = ∑ T ∈ (primeBandUnion P).powerset, (∏ j, primeTiltWeight (P j) lam (T ∩ P j)) * F (fun j ↦ T ∩ P j) := by apply sum_congr rfl intro T hT rw [primeTiltWeight_primeBand_partition P hdis (mem_powerset.mp hT)] _ = _ := sum_powerset_primeBand_partition P hdis (fun U ↦ (∏ j, primeTiltWeight (P j) lam (U j)) * F U) theorem primeBandSelections_filter_card {ι : Type*} [Fintype ι] [DecidableEq ι] (P : ι → Finset ℕ) (n : ι → ℕ) : (primeBandSelections P).filter (fun U ↦ ∀ j, (U j).card = n j) = Fintype.piFinset (fun j ↦ (P j).powerset.filter (fun T ↦ T.card = n j)) := by classical ext U simp [primeBandSelections, forall_and] /-- The partition identity with an entire prescribed vector of band counts. The right-hand domain is definitionally the `bandCardSelections` domain used by the fixed-count tuple comparison. -/ theorem prime_tilt_fixedCounts_expectation_partition {ι : Type*} [Fintype ι] [DecidableEq ι] (P : ι → Finset ℕ) (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) (lam : ℝ) (n : ι → ℕ) (F : (ι → Finset ℕ) → ℝ) : (∑ T ∈ (primeBandUnion P).powerset.filter (fun T ↦ ∀ j, (T ∩ P j).card = n j), primeTiltWeight (primeBandUnion P) lam T * F (fun j ↦ T ∩ P j)) = ∑ U ∈ Fintype.piFinset (fun j ↦ (P j).powerset.filter (fun T ↦ T.card = n j)), (∏ j, primeTiltWeight (P j) lam (U j)) * F U := by classical rw [← primeBandSelections_filter_card] simp only [sum_filter] simpa only [mul_ite, mul_zero] using prime_tilt_expectation_primeBand_partition P hdis lam (fun U ↦ if ∀ j, (U j).card = n j then F U else 0) end Erdos859Verification end /- Inlined development module: PrimeBandTupleOdds.lean -/ section /- Simultaneous fixed-count laws on finitely many prime bands. -/ namespace Erdos859Verification open Finset Real noncomputable def bandCardSelections {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) (n : ι → ℕ) : Finset (ι → Finset ℕ) := by classical exact Fintype.piFinset (fun j ↦ (P j).powerset.filter (fun T ↦ T.card = n j)) abbrev BandTuple {ι : Type*} (P : ι → Finset ℕ) (n : ι → ℕ) := ∀ j, Fin (n j) → P j def bandTupleSigmaEquiv {ι : Type*} (P : ι → Finset ℕ) (n : ι → ℕ) : BandTuple P n ≃ ((ji : Sigma (fun j ↦ Fin (n j))) → P ji.1) where toFun x ji := x ji.1 ji.2 invFun y j i := y ⟨j, i⟩ left_inv _ := rfl right_inv y := by funext ⟨j, i⟩; rfl def bandTupleSupport {ι : Type*} {P : ι → Finset ℕ} {n : ι → ℕ} (x : BandTuple P n) : ι → Finset ℕ := fun j ↦ tupleSupport (x j) abbrev BandTupleDistinct {ι : Type*} {P : ι → Finset ℕ} {n : ι → ℕ} (x : BandTuple P n) : Prop := ∀ j, Function.Injective (x j) noncomputable def distinctBandTuples {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) (n : ι → ℕ) : Finset (BandTuple P n) := by classical exact univ.filter BandTupleDistinct theorem mem_bandCardSelections {ι : Type*} [Fintype ι] {P : ι → Finset ℕ} {n : ι → ℕ} {T : ι → Finset ℕ} : T ∈ bandCardSelections P n ↔ ∀ j, T j ⊆ P j ∧ (T j).card = n j := by classical simp [bandCardSelections] theorem bandCardSelections_eq_piFinset {ι : Type*} [Fintype ι] [DecidableEq ι] (P : ι → Finset ℕ) (n : ι → ℕ) : bandCardSelections P n = Fintype.piFinset (fun j ↦ (P j).powerset.filter (fun T ↦ T.card = n j)) := by ext T simp [bandCardSelections] theorem card_bandTupleSupport_fiber {ι : Type*} [Fintype ι] {P : ι → Finset ℕ} {n : ι → ℕ} {T : ι → Finset ℕ} (hT : ∀ j, T j ⊆ P j ∧ (T j).card = n j) : ((distinctBandTuples P n).filter (fun x ↦ bandTupleSupport x = T)).card = ∏ j, (n j).factorial := by classical have heq : (distinctBandTuples P n).filter (fun x ↦ bandTupleSupport x = T) = univ.filter (fun x : BandTuple P n ↦ ∀ j, Function.Injective (x j) ∧ tupleSupport (x j) = T j) := by ext x simp [distinctBandTuples, bandTupleSupport, funext_iff, forall_and] rw [heq] have hcard := Fintype.card_congr (Equiv.subtypePiEquivPi (p := fun j (x : Fin (n j) → P j) ↦ Function.Injective x ∧ tupleSupport x = T j)) simp only [Fintype.card_subtype, Fintype.card_pi] at hcard rw [hcard] apply prod_congr rfl intro j _ exact card_tupleSupport_fiber (hT j).1 (hT j).2 theorem sum_distinct_bandTuple_support {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) (n : ι → ℕ) (G : (ι → Finset ℕ) → ℝ) : (∑ x ∈ distinctBandTuples P n, G (bandTupleSupport x)) = (∏ j, ((n j).factorial : ℝ)) * ∑ T ∈ bandCardSelections P n, G T := by classical have hmap : ∀ x ∈ distinctBandTuples P n, bandTupleSupport x ∈ bandCardSelections P n := by intro x hx apply mem_bandCardSelections.mpr intro j exact ⟨tupleSupport_subset (x j), card_tupleSupport (x j) ((mem_filter.mp hx).2 j)⟩ calc _ = ∑ T ∈ bandCardSelections P n, ∑ x ∈ (distinctBandTuples P n).filter (fun x ↦ bandTupleSupport x = T), G T := (sum_fiberwise_of_maps_to' hmap G).symm _ = ∑ T ∈ bandCardSelections P n, (∏ j, ((n j).factorial : ℝ)) * G T := by apply sum_congr rfl intro T hT rw [sum_const, nsmul_eq_mul, card_bandTupleSupport_fiber (mem_bandCardSelections.mp hT), Nat.cast_prod] _ = _ := (mul_sum _ _ _).symm theorem distinct_bandTuple_product_expectation {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) (n : ι → ℕ) (w : ι → ℕ → ℝ) (F : (ι → Finset ℕ) → ℝ) : (∑ x ∈ distinctBandTuples P n, (∏ j, ∏ i, w j (x j i).val) * F (bandTupleSupport x)) / (∑ x ∈ distinctBandTuples P n, ∏ j, ∏ i, w j (x j i).val) = (∑ T ∈ bandCardSelections P n, (∏ j, ∏ p ∈ T j, w j p) * F T) / (∑ T ∈ bandCardSelections P n, ∏ j, ∏ p ∈ T j, w j p) := by classical have hw (x : BandTuple P n) (hx : x ∈ distinctBandTuples P n) : (∏ j, ∏ i, w j (x j i).val) = ∏ j, ∏ p ∈ bandTupleSupport x j, w j p := by apply prod_congr rfl intro j _ exact (prod_tupleSupport (x j) ((mem_filter.mp hx).2 j) (w j)).symm have hsum (G : (ι → Finset ℕ) → ℝ) : (∑ x ∈ distinctBandTuples P n, (∏ j, ∏ i, w j (x j i).val) * G (bandTupleSupport x)) = (∏ j, ((n j).factorial : ℝ)) * ∑ T ∈ bandCardSelections P n, (∏ j, ∏ p ∈ T j, w j p) * G T := by calc _ = ∑ x ∈ distinctBandTuples P n, (∏ j, ∏ p ∈ bandTupleSupport x j, w j p) * G (bandTupleSupport x) := by apply sum_congr rfl intro x hx rw [hw x hx] _ = _ := sum_distinct_bandTuple_support P n (fun T ↦ (∏ j, ∏ p ∈ T j, w j p) * G T) have hden := hsum (fun _ ↦ 1) simp only [mul_one] at hden rw [hsum, hden] exact mul_div_mul_left _ _ (prod_ne_zero_iff.mpr fun j _ ↦ by exact_mod_cast Nat.factorial_ne_zero (n j)) noncomputable def bandReciprocalTupleWeight {ι : Type*} [Fintype ι] {P : ι → Finset ℕ} {n : ι → ℕ} (M : ι → ℝ) (x : BandTuple P n) : ℝ := ∏ j, reciprocalTupleWeight (M j) (x j) noncomputable def bandTupleOddsRatio {ι : Type*} [Fintype ι] {P : ι → Finset ℕ} {n : ι → ℕ} (x : BandTuple P n) : ℝ := ∏ j, primeTupleOddsRatio (x j) theorem bandReciprocalTupleWeight_eq_sigma {ι : Type*} [Fintype ι] [DecidableEq ι] {P : ι → Finset ℕ} {n : ι → ℕ} (M : ι → ℝ) (x : BandTuple P n) : bandReciprocalTupleWeight M x = finiteProductWeight (fun (ji : Sigma (fun j ↦ Fin (n j))) (p : P ji.1) ↦ (1 / (p.val : ℝ)) / M ji.1) (bandTupleSigmaEquiv P n x) := by simp [bandReciprocalTupleWeight, reciprocalTupleWeight, finiteProductWeight, Fintype.prod_sigma, bandTupleSigmaEquiv] theorem bandTuple_reweight_eq_odds {ι : Type*} [Fintype ι] {P : ι → Finset ℕ} {n : ι → ℕ} (hP : ∀ j p, p ∈ P j → p.Prime) (M : ι → ℝ) (x : BandTuple P n) : bandReciprocalTupleWeight M x * bandTupleOddsRatio x = (∏ j, ∏ i, 1 / (((x j i).val : ℝ) - 1)) / (∏ j, M j ^ n j) := by unfold bandReciprocalTupleWeight bandTupleOddsRatio rw [← prod_mul_distrib] simp_rw [reciprocalTupleWeight_mul_oddsRatio (hP _)] rw [prod_div_distrib] theorem bandTilt_fixedCounts_expectation_eq_reweighted_tuples {ι : Type*} [Fintype ι] {P : ι → Finset ℕ} (hP : ∀ j p, p ∈ P j → p.Prime) {lam : ℝ} (hlam : 0 < lam) (M : ι → ℝ) (hM : ∀ j, M j ≠ 0) (n : ι → ℕ) (F : (ι → Finset ℕ) → ℝ) : (∑ T ∈ bandCardSelections P n, (∏ j, primeTiltWeight (P j) lam (T j)) * F T) / (∑ T ∈ bandCardSelections P n, ∏ j, primeTiltWeight (P j) lam (T j)) = (∑ x ∈ distinctBandTuples P n, bandReciprocalTupleWeight M x * bandTupleOddsRatio x * F (bandTupleSupport x)) / (∑ x ∈ distinctBandTuples P n, bandReciprocalTupleWeight M x * bandTupleOddsRatio x) := by classical let K : ℝ := ∏ j, primePatternWeight (P j) ∅ * lam ^ n j / primeTiltNormalizer (P j) lam have hK : 0 < K := prod_pos fun j _ ↦ div_pos (mul_pos (primePatternWeight_pos (hP j) ∅) (pow_pos hlam (n j))) (primeTiltNormalizer_pos (hP j) hlam) have hfactor (T : ι → Finset ℕ) (hT : T ∈ bandCardSelections P n) : (∏ j, primeTiltWeight (P j) lam (T j)) = K * ∏ j, primeOddsWeight (T j) := by rw [← prod_mul_distrib] apply prod_congr rfl intro j _ exact primeTiltWeight_fixedCard_factorization (hP j) ((mem_bandCardSelections.mp hT) j).1 ((mem_bandCardSelections.mp hT) j).2 lam have hsum (G : (ι → Finset ℕ) → ℝ) : (∑ T ∈ bandCardSelections P n, (∏ j, primeTiltWeight (P j) lam (T j)) * G T) = K * ∑ T ∈ bandCardSelections P n, (∏ j, primeOddsWeight (T j)) * G T := by rw [mul_sum] apply sum_congr rfl intro T hT rw [hfactor T hT, mul_assoc] have hden := hsum (fun _ ↦ 1) simp only [mul_one] at hden rw [hsum, hden, mul_div_mul_left _ _ hK.ne'] change (∑ T ∈ bandCardSelections P n, (∏ j, ∏ p ∈ T j, 1 / ((p : ℝ) - 1)) * F T) / (∑ T ∈ bandCardSelections P n, ∏ j, ∏ p ∈ T j, 1 / ((p : ℝ) - 1)) = _ rw [← distinct_bandTuple_product_expectation P n (fun _ p ↦ 1 / ((p : ℝ) - 1)) F] have hnum : (∑ x ∈ distinctBandTuples P n, bandReciprocalTupleWeight M x * bandTupleOddsRatio x * F (bandTupleSupport x)) = (∑ x ∈ distinctBandTuples P n, (∏ j, ∏ i, 1 / (((x j i).val : ℝ) - 1)) * F (bandTupleSupport x)) / (∏ j, M j ^ n j) := by rw [sum_div] apply sum_congr rfl intro x _ rw [bandTuple_reweight_eq_odds hP] ring have hden' : (∑ x ∈ distinctBandTuples P n, bandReciprocalTupleWeight M x * bandTupleOddsRatio x) = (∑ x ∈ distinctBandTuples P n, ∏ j, ∏ i, 1 / (((x j i).val : ℝ) - 1)) / (∏ j, M j ^ n j) := by simp_rw [bandTuple_reweight_eq_odds hP] rw [sum_div] rw [hnum, hden', div_div_div_cancel_right₀ (prod_ne_zero_iff.mpr fun j _ ↦ pow_ne_zero _ (hM j))] theorem bandTupleOddsRatio_bounds {ι : Type*} [Fintype ι] {P : ι → Finset ℕ} {n : ι → ℕ} (hP : ∀ j p, p ∈ P j → p.Prime) (a : ι → ℝ) (hlarge : ∀ j p, p ∈ P j → a j ≤ log (p : ℝ)) (x : BandTuple P n) (hx : BandTupleDistinct x) : 1 ≤ bandTupleOddsRatio x ∧ bandTupleOddsRatio x ≤ exp (2 * ∑ j, (n j : ℝ) * exp (-a j)) := by have hj (j : ι) := primeTupleOddsRatio_bounds (hP j) (hlarge j) (x j) (hx j) constructor · exact one_le_prod (fun j _ ↦ (hj j).1) · calc _ ≤ ∏ j, exp (2 * (n j : ℝ) * exp (-a j)) := Finset.prod_le_prod (fun j _ ↦ le_trans (by norm_num) (hj j).1) (fun j _ ↦ (hj j).2) _ = exp (∑ j, 2 * (n j : ℝ) * exp (-a j)) := (exp_sum _ _).symm _ = _ := by congr 1; rw [mul_sum]; apply sum_congr rfl; intro j _; ring theorem bandTilt_fixedCounts_expectation_le_two_iid {ι : Type*} [Fintype ι] [DecidableEq ι] {P : ι → Finset ℕ} (hP : ∀ j p, p ∈ P j → p.Prime) {lam : ℝ} (hlam : 0 < lam) (M : ι → ℝ) (hM : ∀ j, 0 < M j) (n : ι → ℕ) (F : (ι → Finset ℕ) → ℝ) (hF : ∀ T, 0 ≤ F T) (a : ι → ℝ) (hlarge : ∀ j p, p ∈ P j → a j ≤ log (p : ℝ)) (hratio : exp (2 * ∑ j, (n j : ℝ) * exp (-a j)) ≤ 3 / 2) (hmass : (3 : ℝ) / 4 ≤ ∑ x ∈ distinctBandTuples P n, bandReciprocalTupleWeight M x) : (∑ T ∈ bandCardSelections P n, (∏ j, primeTiltWeight (P j) lam (T j)) * F T) / (∑ T ∈ bandCardSelections P n, ∏ j, primeTiltWeight (P j) lam (T j)) ≤ 2 * ∑ x : BandTuple P n, bandReciprocalTupleWeight M x * F (bandTupleSupport x) := by classical rw [bandTilt_fixedCounts_expectation_eq_reweighted_tuples hP hlam M (fun j ↦ (hM j).ne')] apply finite_normalized_reweight_le_two _ _ _ _ · intro x apply prod_nonneg intro j _ unfold reciprocalTupleWeight apply finiteProductWeight_nonneg intro i p exact div_nonneg (by positivity) (hM j).le · intro x exact hF (bandTupleSupport x) · intro x hx exact (bandTupleOddsRatio_bounds hP a hlarge x (mem_filter.mp hx).2).1 · intro x hx exact (bandTupleOddsRatio_bounds hP a hlarge x (mem_filter.mp hx).2).2.trans hratio · exact hmass theorem bandTilt_fixedCounts_expectation_le_two_iid_extension {ι : Type*} [Fintype ι] [DecidableEq ι] {P : ι → Finset ℕ} (hP : ∀ j p, p ∈ P j → p.Prime) {lam : ℝ} (hlam : 0 < lam) (M : ι → ℝ) (hM : ∀ j, 0 < M j) (n : ι → ℕ) (F : (ι → Finset ℕ) → ℝ) (G : BandTuple P n → ℝ) (hG : ∀ x, 0 ≤ G x) (hmatch : ∀ x ∈ distinctBandTuples P n, F (bandTupleSupport x) = G x) (a : ι → ℝ) (hlarge : ∀ j p, p ∈ P j → a j ≤ log (p : ℝ)) (hratio : exp (2 * ∑ j, (n j : ℝ) * exp (-a j)) ≤ 3 / 2) (hmass : (3 : ℝ) / 4 ≤ ∑ x ∈ distinctBandTuples P n, bandReciprocalTupleWeight M x) : (∑ T ∈ bandCardSelections P n, (∏ j, primeTiltWeight (P j) lam (T j)) * F T) / (∑ T ∈ bandCardSelections P n, ∏ j, primeTiltWeight (P j) lam (T j)) ≤ 2 * ∑ x : BandTuple P n, bandReciprocalTupleWeight M x * G x := by classical rw [bandTilt_fixedCounts_expectation_eq_reweighted_tuples hP hlam M (fun j ↦ (hM j).ne')] have hnum : (∑ x ∈ distinctBandTuples P n, bandReciprocalTupleWeight M x * bandTupleOddsRatio x * F (bandTupleSupport x)) = ∑ x ∈ distinctBandTuples P n, bandReciprocalTupleWeight M x * bandTupleOddsRatio x * G x := by apply sum_congr rfl intro x hx rw [hmatch x hx] rw [hnum] apply finite_normalized_reweight_le_two _ _ _ _ · intro x apply prod_nonneg intro j _ unfold reciprocalTupleWeight apply finiteProductWeight_nonneg intro i p exact div_nonneg (by positivity) (hM j).le · exact hG · intro x hx exact (bandTupleOddsRatio_bounds hP a hlarge x (mem_filter.mp hx).2).1 · intro x hx exact (bandTupleOddsRatio_bounds hP a hlarge x (mem_filter.mp hx).2).2.trans hratio · exact hmass theorem ambient_primeTilt_fixedCounts_expectation_eq_reweighted_tuples {ι : Type*} [Fintype ι] [DecidableEq ι] (P : ι → Finset ℕ) (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) (hP : ∀ j p, p ∈ P j → p.Prime) {lam : ℝ} (hlam : 0 < lam) (M : ι → ℝ) (hM : ∀ j, M j ≠ 0) (n : ι → ℕ) (F : (ι → Finset ℕ) → ℝ) : (∑ T ∈ (primeBandUnion P).powerset.filter (fun T ↦ ∀ j, (T ∩ P j).card = n j), primeTiltWeight (primeBandUnion P) lam T * F (fun j ↦ T ∩ P j)) / (∑ T ∈ (primeBandUnion P).powerset.filter (fun T ↦ ∀ j, (T ∩ P j).card = n j), primeTiltWeight (primeBandUnion P) lam T) = (∑ x ∈ distinctBandTuples P n, bandReciprocalTupleWeight M x * bandTupleOddsRatio x * F (bandTupleSupport x)) / (∑ x ∈ distinctBandTuples P n, bandReciprocalTupleWeight M x * bandTupleOddsRatio x) := by have hden := prime_tilt_fixedCounts_expectation_partition P hdis lam n (fun _ ↦ 1) simp only [mul_one] at hden rw [prime_tilt_fixedCounts_expectation_partition P hdis lam n F, hden] rw [← bandCardSelections_eq_piFinset P n] exact bandTilt_fixedCounts_expectation_eq_reweighted_tuples hP hlam M hM n F theorem ambient_primeTilt_fixedCounts_expectation_le_two_iid_extension {ι : Type*} [Fintype ι] [DecidableEq ι] (P : ι → Finset ℕ) (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) (hP : ∀ j p, p ∈ P j → p.Prime) {lam : ℝ} (hlam : 0 < lam) (M : ι → ℝ) (hM : ∀ j, 0 < M j) (n : ι → ℕ) (F : (ι → Finset ℕ) → ℝ) (G : BandTuple P n → ℝ) (hG : ∀ x, 0 ≤ G x) (hmatch : ∀ x ∈ distinctBandTuples P n, F (bandTupleSupport x) = G x) (a : ι → ℝ) (hlarge : ∀ j p, p ∈ P j → a j ≤ log (p : ℝ)) (hratio : exp (2 * ∑ j, (n j : ℝ) * exp (-a j)) ≤ 3 / 2) (hmass : (3 : ℝ) / 4 ≤ ∑ x ∈ distinctBandTuples P n, bandReciprocalTupleWeight M x) : (∑ T ∈ (primeBandUnion P).powerset.filter (fun T ↦ ∀ j, (T ∩ P j).card = n j), primeTiltWeight (primeBandUnion P) lam T * F (fun j ↦ T ∩ P j)) / (∑ T ∈ (primeBandUnion P).powerset.filter (fun T ↦ ∀ j, (T ∩ P j).card = n j), primeTiltWeight (primeBandUnion P) lam T) ≤ 2 * ∑ x : BandTuple P n, bandReciprocalTupleWeight M x * G x := by have hden := prime_tilt_fixedCounts_expectation_partition P hdis lam n (fun _ ↦ 1) simp only [mul_one] at hden rw [prime_tilt_fixedCounts_expectation_partition P hdis lam n F, hden] rw [← bandCardSelections_eq_piFinset P n] exact bandTilt_fixedCounts_expectation_le_two_iid_extension hP hlam M hM n F G hG hmatch a hlarge hratio hmass end Erdos859Verification end /- Inlined development module: FiniteBandDuplicates.lean -/ section /- One global duplicate bound for a finite product of independent bands. -/ open Finset namespace Erdos859Verification theorem finite_product_bad_coordinate_le {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} [∀ i, Fintype (α i)] (w : ∀ i, α i → ℝ) (bad : ∀ i, α i → Prop) [∀ i, DecidablePred (bad i)] (a : ι → ℝ) (hw : ∀ i y, 0 ≤ w i y) (hnorm : ∀ i, ∑ y, w i y = 1) (hbad : ∀ i, (∑ y, w i y * (if bad i y then 1 else 0)) ≤ a i) : (∑ x : ∀ i, α i, finiteProductWeight w x * (if ∃ i, bad i (x i) then 1 else 0)) ≤ ∑ i, a i := by classical calc _ ≤ ∑ i, ∑ x : ∀ i, α i, finiteProductWeight w x * (if bad i (x i) then 1 else 0) := by simpa only [mem_univ, true_and] using finite_weighted_union_bound_general univ univ (finiteProductWeight w) (fun x _ ↦ finiteProductWeight_nonneg hw x) (fun i x ↦ bad i (x i)) _ ≤ _ := by apply sum_le_sum intro i _ apply finite_product_section_bound w (fun x ↦ if bad i (x i) then 1 else 0) i (a i) hw hnorm intro z simpa only [Equiv.piSplitAt_symm_apply, dite_true] using hbad i theorem finite_iid_not_injective_probability_le {α : Type*} [Fintype α] [DecidableEq α] (n : ℕ) (w : α → ℝ) {a : ℝ} (ha : 0 ≤ a) (hw : ∀ y, 0 ≤ w y) (hnorm : ∑ y, w y = 1) (hatom : ∀ y, w y ≤ a) : (∑ x : Fin n → α, finiteProductWeight (fun _ ↦ w) x * (if ¬ Function.Injective x then 1 else 0)) ≤ (n : ℝ) ^ 2 * a := by classical have hevent (x : Fin n → α) : (¬ Function.Injective x) ↔ ∃ i j : Fin n, i ≠ j ∧ x i = x j := by constructor · intro h by_contra hn apply h intro i j hij by_contra hne exact hn ⟨i, j, hne, hij⟩ · rintro ⟨i, j, hne, hij⟩ h exact hne (h hij) simpa only [hevent] using finite_iid_duplicate_probability_le n w ha hw hnorm hatom theorem finite_band_iid_duplicate_probability_le {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} [∀ i, Fintype (α i)] [∀ i, DecidableEq (α i)] (n : ι → ℕ) (w : ∀ i, α i → ℝ) (a : ι → ℝ) (ha : ∀ i, 0 ≤ a i) (hw : ∀ i y, 0 ≤ w i y) (hnorm : ∀ i, ∑ y, w i y = 1) (hatom : ∀ i y, w i y ≤ a i) : (∑ x : ∀ i, Fin (n i) → α i, finiteProductWeight (fun i ↦ finiteProductWeight (fun _ : Fin (n i) ↦ w i)) x * (if ∃ i, ¬ Function.Injective (x i) then 1 else 0)) ≤ ∑ i, (n i : ℝ) ^ 2 * a i := by apply finite_product_bad_coordinate_le (fun i ↦ finiteProductWeight (fun _ : Fin (n i) ↦ w i)) (fun _ x ↦ ¬ Function.Injective x) (fun i ↦ (n i : ℝ) ^ 2 * a i) · intro i exact finiteProductWeight_nonneg (fun _ ↦ hw i) · intro i exact sum_finiteProductWeight _ (fun _ ↦ hnorm i) · intro i exact finite_iid_not_injective_probability_le (n i) (w i) (ha i) (hw i) (hnorm i) (hatom i) /-- The loss is summed over all bands before normalizing. It does not multiply a fixed conditioning loss once per band. -/ theorem finite_band_iid_distinct_mass_lower {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} [∀ i, Fintype (α i)] [∀ i, DecidableEq (α i)] (n : ι → ℕ) (w : ∀ i, α i → ℝ) (a : ι → ℝ) (ha : ∀ i, 0 ≤ a i) (hw : ∀ i y, 0 ≤ w i y) (hnorm : ∀ i, ∑ y, w i y = 1) (hatom : ∀ i y, w i y ≤ a i) : 1 - (∑ i, (n i : ℝ) ^ 2 * a i) ≤ ∑ x : ∀ i, Fin (n i) → α i with ∀ i, Function.Injective (x i), finiteProductWeight (fun i ↦ finiteProductWeight (fun _ : Fin (n i) ↦ w i)) x := by classical let W := finiteProductWeight (fun i ↦ finiteProductWeight (fun _ : Fin (n i) ↦ w i)) have hbad := finite_band_iid_duplicate_probability_le n w a ha hw hnorm hatom have hnorm' : (∑ x : ∀ i, Fin (n i) → α i, W x) = 1 := sum_finiteProductWeight _ (fun i ↦ sum_finiteProductWeight _ (fun _ ↦ hnorm i)) have hsplit := sum_filter_add_sum_filter_not univ (fun x : ∀ i, Fin (n i) → α i ↦ ∃ i, ¬ Function.Injective (x i)) W simp only [mul_ite, mul_one, mul_zero, ← sum_filter] at hbad simp only [not_exists, not_not] at hsplit change _ ≤ _ at hbad rw [hnorm'] at hsplit linarith end Erdos859Verification end /- Inlined development module: PrimeBandRegularityComparison.lean -/ section /- Quadratic count regularity controls one global sampling comparison. -/ open Finset Real namespace Erdos859Verification noncomputable def primeMarkRegularityCutoff : ℝ := min (log 2 / 8) (log (3 / 2) / 2) theorem primeMarkRegularityCutoff_pos : 0 < primeMarkRegularityCutoff := by unfold primeMarkRegularityCutoff apply lt_min · positivity [log_pos (by norm_num : (1 : ℝ) < 2)] · positivity [log_pos (by norm_num : (1 : ℝ) < 3 / 2)] noncomputable def primeBandCountRegularity {ι : Type*} [Fintype ι] (a : ι → ℝ) (n : ι → ℕ) : ℝ := ∑ j, (n j : ℝ) ^ 2 * exp (-a j) theorem primeLogMarkWeight_atom_bound {a : ℝ} (ha : log 2 ≤ a) (hlarge : 4 * mertensErrorConstant ≤ a * log 2) (p : primeLogWindow a (2 * a)) : primeLogMarkWeight a (2 * a) p ≤ (2 / log 2) * exp (-a) := by have hp := mem_primeLogWindow.mp p.property have hp0 : (0 : ℝ) < (p : ℕ) := by exact_mod_cast hp.1.pos have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hmass := primeLogWindowMass_dyadic_lower ha hlarge have hmass0 : 0 < primeLogWindowMass a (2 * a) := (half_pos hlog).trans_le hmass have hrecip : 1 / ((p : ℕ) : ℝ) ≤ exp (-a) := by rw [exp_neg, ← one_div] apply one_div_le_one_div_of_le (exp_pos a) calc exp a ≤ exp (log ((p : ℕ) : ℝ)) := exp_le_exp.mpr hp.2.1.le _ = _ := exp_log hp0 unfold primeLogMarkWeight calc _ ≤ exp (-a) / primeLogWindowMass a (2 * a) := div_le_div_of_nonneg_right hrecip hmass0.le _ ≤ exp (-a) / (log 2 / 2) := div_le_div_of_nonneg_left (exp_pos _).le (half_pos hlog) hmass _ = _ := by ring theorem primeBandCountRegularity_linear_le {ι : Type*} [Fintype ι] (a : ι → ℝ) (n : ι → ℕ) : (∑ j, (n j : ℝ) * exp (-a j)) ≤ primeBandCountRegularity a n := by apply sum_le_sum intro j _ apply mul_le_mul_of_nonneg_right _ (exp_pos _).le rcases (n j).eq_zero_or_pos with hz | hp · simp [hz] · have hn : 1 ≤ (n j : ℝ) := by exact_mod_cast hp nlinarith [sq_nonneg ((n j : ℝ) - 1)] theorem regular_primeBand_likelihood_bound {ι : Type*} [Fintype ι] (a : ι → ℝ) (n : ι → ℕ) (hreg : primeBandCountRegularity a n ≤ primeMarkRegularityCutoff) : exp (2 * ∑ j, (n j : ℝ) * exp (-a j)) ≤ 3 / 2 := by have hlin := primeBandCountRegularity_linear_le a n have hreg' := hreg.trans (min_le_right (log 2 / 8) (log (3 / 2) / 2)) calc _ ≤ exp (log (3 / 2)) := exp_le_exp.mpr (by linarith) _ = _ := exp_log (by norm_num) /-- Distinctness costs at most one quarter in total over all bands. -/ theorem regular_primeBand_distinct_mass {ι : Type*} [Fintype ι] [DecidableEq ι] (a : ι → ℝ) (n : ι → ℕ) (ha : ∀ j, log 2 ≤ a j) (hlarge : ∀ j, 4 * mertensErrorConstant ≤ a j * log 2) (hreg : primeBandCountRegularity a n ≤ primeMarkRegularityCutoff) : (3 : ℝ) / 4 ≤ ∑ x ∈ distinctBandTuples (fun j ↦ primeLogWindow (a j) (2 * a j)) n, bandReciprocalTupleWeight (fun j ↦ primeLogWindowMass (a j) (2 * a j)) x := by classical let P := fun j ↦ primeLogWindow (a j) (2 * a j) let w := fun j (p : P j) ↦ primeLogMarkWeight (a j) (2 * a j) p have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hmass j : 0 < primeLogWindowMass (a j) (2 * a j) := (half_pos hlog).trans_le (primeLogWindowMass_dyadic_lower (ha j) (hlarge j)) have hw : ∀ j p, 0 ≤ w j p := by intro j p dsimp [w, primeLogMarkWeight] exact div_nonneg (by positivity) (hmass j).le have hnorm : ∀ j, (∑ p : P j, w j p) = 1 := by intro j change (∑ p : primeLogWindow (a j) (2 * a j), primeLogMarkWeight (a j) (2 * a j) p) = 1 rw [sum_coe_sort] exact sum_primeLogMarkWeight (hmass j) have hdist := finite_band_iid_distinct_mass_lower n w (fun j ↦ (2 / log 2) * exp (-a j)) (fun _ ↦ by positivity) hw hnorm (fun j p ↦ primeLogMarkWeight_atom_bound (ha j) (hlarge j) p) have hsum : (∑ j, (n j : ℝ) ^ 2 * ((2 / log 2) * exp (-a j))) = (2 / log 2) * primeBandCountRegularity a n := by unfold primeBandCountRegularity rw [mul_sum] apply sum_congr rfl intro j _ ring have hloss : (2 / log 2) * primeBandCountRegularity a n ≤ 1 / 4 := by calc _ ≤ (2 / log 2) * (log 2 / 8) := mul_le_mul_of_nonneg_left (hreg.trans (min_le_left _ _)) (by positivity) _ = _ := by field_simp; norm_num rw [hsum] at hdist have hbound : (3 : ℝ) / 4 ≤ ∑ x : ∀ j, Fin (n j) → P j with ∀ j, Function.Injective (x j), finiteProductWeight (fun j ↦ finiteProductWeight (fun _ : Fin (n j) ↦ w j)) x := by linarith have hdset : distinctBandTuples P n = (univ.filter (fun x : BandTuple P n ↦ ∀ j, Function.Injective (x j))) := by ext x simp [distinctBandTuples] change (3 : ℝ) / 4 ≤ ∑ x ∈ distinctBandTuples P n, bandReciprocalTupleWeight (fun j ↦ primeLogWindowMass (a j) (2 * a j)) x rw [hdset] simpa only [bandReciprocalTupleWeight, reciprocalTupleWeight, finiteProductWeight, w, primeLogMarkWeight, P] using hbound end Erdos859Verification end /- Inlined development module: PrimeDyadicCoordinates.lean -/ section /- Selected count vectors as coordinates for the independent-mark model. -/ open Finset Real namespace Erdos859Verification /-- One coordinate for each selected prime count in each dyadic band. -/ abbrev DyadicCountCoordinate (A : ℝ) (k : ℕ) (T : Finset ℕ) : Type := Σ j : Fin k, Fin ((T ∩ dyadicPrimeBand A j.val).card) def dyadicCountCoordinateBand {A : ℝ} {k : ℕ} {T : Finset ℕ} (i : DyadicCountCoordinate A k T) : Fin k := i.1 theorem sigmaFinCount_card (k : ℕ) (n : ℕ → ℕ) : Fintype.card (Σ j : Fin k, Fin (n j.val)) = ∑ j ∈ range k, n j := by rw [Fintype.card_sigma] simp only [Fintype.card_fin] exact Fin.sum_univ_eq_sum_range n k /-- Counting coordinates whose first coordinate lies above a cutoff is exactly summing the corresponding band counts. -/ theorem sigmaFinCount_card_above (k m : ℕ) (n : ℕ → ℕ) : ((univ : Finset (Σ j : Fin k, Fin (n j.val))).filter (fun i ↦ m < i.1.val)).card = ∑ j ∈ Ico (m + 1) k, n j := by rw [Finset.card_eq_sum_ones, sum_filter, Fintype.sum_sigma] change (∑ j : Fin k, ∑ _ : Fin (n j.val), if m < j.val then (1 : ℕ) else 0) = _ have hinner (j : Fin k) : (∑ _ : Fin (n j.val), if m < j.val then (1 : ℕ) else 0) = if m < j.val then n j.val else 0 := by by_cases hj : m < j.val <;> simp [hj] simp_rw [hinner] rw [Fin.sum_univ_eq_sum_range (fun j : ℕ ↦ if m < j then n j else 0), ← sum_filter] have heq : (range k).filter (fun j ↦ m < j) = Ico (m + 1) k := by ext j simp only [Finset.mem_filter, Finset.mem_range, Finset.mem_Ico] omega rw [heq] theorem dyadicCountCoordinate_card {A : ℝ} (hA : 0 < A) (k : ℕ) (T : Finset ℕ) : Fintype.card (DyadicCountCoordinate A k T) = (T ∩ dyadicPrimeUniverse A k).card := by rw [card_inter_dyadicPrimeUniverse hA] exact sigmaFinCount_card k (fun j ↦ (T ∩ dyadicPrimeBand A j).card) theorem dyadicCountCoordinate_card_eq_card {A : ℝ} (hA : 0 < A) {k : ℕ} {T : Finset ℕ} (hT : T ⊆ dyadicPrimeUniverse A k) : Fintype.card (DyadicCountCoordinate A k T) = T.card := by rw [dyadicCountCoordinate_card hA, inter_eq_left.mpr hT] theorem dyadicCountCoordinate_card_above {A : ℝ} (hA : 0 < A) {k : ℕ} (T : Finset ℕ) (j : Fin k) : ((univ : Finset (DyadicCountCoordinate A k T)).filter (fun i ↦ j < dyadicCountCoordinateBand i)).card = (T ∩ (Ico (j.val + 1) k).biUnion (dyadicPrimeBand A)).card := by rw [card_inter_dyadicPrimeBands hA] simpa only [dyadicCountCoordinateBand, Fin.lt_def] using sigmaFinCount_card_above k j.val (fun b ↦ (T ∩ dyadicPrimeBand A b).card) theorem dyadicPrimeTail_above {A : ℝ} {k : ℕ} (j : Fin k) (hj : j.val + 1 < k) : dyadicPrimeTail A k (k - 2 - j.val) = (Ico (j.val + 1) k).biUnion (dyadicPrimeBand A) := by have hstart : k - (k - 2 - j.val + 1) = j.val + 1 := by omega simp only [dyadicPrimeTail, hstart] theorem dyadicCountCoordinate_card_above_tail {A : ℝ} (hA : 0 < A) {k : ℕ} (T : Finset ℕ) (j : Fin k) (hj : j.val + 1 < k) : ((univ : Finset (DyadicCountCoordinate A k T)).filter (fun i ↦ j < dyadicCountCoordinateBand i)).card = (T ∩ dyadicPrimeTail A k (k - 2 - j.val)).card := by rw [dyadicPrimeTail_above j hj] exact dyadicCountCoordinate_card_above hA T j /-- The prime-set reverse barrier supplies exactly the coordinate-count hypotheses of the independent-mark collision bound, including the top band and the empty family of bands. -/ theorem dyadicCountCoordinate_barrier_conditions {A v : ℝ} {k D : ℕ} {T : Finset ℕ} (hA : 0 < A) (hv : 1 < v) (hgood : ¬ ReverseCountBarrierFailure k v D (dyadicPrimeTail A k) T) : 0 < v - 1 ∧ (∀ j : Fin k, (1 + (v - 1)) * ((k - 1 - j.val : ℕ) : ℝ) - (D : ℝ) ≤ (((univ : Finset (DyadicCountCoordinate A k T)).filter (fun i ↦ j < dyadicCountCoordinateBand i)).card : ℝ)) ∧ (k : ℝ) - (D : ℝ) ≤ Fintype.card (DyadicCountCoordinate A k T) := by have htail (ell : ℕ) (hell : ell < k) : v * (ell + 1 : ℕ) - (D : ℝ) < (T ∩ dyadicPrimeTail A k ell).card := by apply lt_of_not_ge intro h exact hgood ⟨ell, Finset.mem_range.mpr hell, h⟩ refine ⟨sub_pos.mpr hv, ?_, ?_⟩ · intro j by_cases hj : j.val + 1 < k · have hell : k - 2 - j.val < k := by omega have hlength : k - 2 - j.val + 1 = k - 1 - j.val := by omega have ht := (htail (k - 2 - j.val) hell).le rw [hlength] at ht rw [dyadicCountCoordinate_card_above_tail hA T j hj] have heq : 1 + (v - 1) = v := by ring rw [heq] exact ht · have hlength : k - 1 - j.val = 0 := by omega rw [hlength] simp only [Nat.cast_zero, mul_zero, zero_sub] exact (neg_nonpos.mpr (Nat.cast_nonneg D)).trans (Nat.cast_nonneg _) · by_cases hk : k = 0 · subst k simp only [Nat.cast_zero, zero_sub] exact (neg_nonpos.mpr (Nat.cast_nonneg D)).trans (Nat.cast_nonneg _) · have hkpos : 0 < k := Nat.pos_of_ne_zero hk have ht := (htail (k - 1) (by omega)).le rw [dyadicPrimeTail_full hkpos, Nat.sub_add_cancel hkpos] at ht rw [dyadicCountCoordinate_card hA] have hvk : (k : ℝ) ≤ v * (k : ℝ) := by simpa only [one_mul] using mul_le_mul_of_nonneg_right hv.le (Nat.cast_nonneg k) exact (sub_le_sub_right hvk (D : ℝ)).trans ht end Erdos859Verification end /- Inlined development module: DyadicPrimeSupportCounts.lean -/ section /- Adjustable support-probability bounds for actual dyadic count vectors. -/ open Finset Real MeasureTheory namespace Erdos859Verification /-- The support threshold can be traded against any failure budget `1 / L`. This form permits a later comparison of the iid mark law with the exact conditional prime law. -/ theorem dyadicPrimeMark_bad_support_weight_le {ι : Type*} [Fintype ι] [DecidableEq ι] {k : ℕ} (band : ι → Fin k) {A b d eps D L : ℝ} (ha : log 2 ≤ A) (hlarge : 4 * mertensErrorConstant ≤ A * log 2) (hb : 0 < b) (hd : 1 ≤ d) (hscale : b * A ≤ d) (heps : 0 < eps) (hL : 0 < L) (hbarrier : ∀ j : Fin k, (1 + eps) * ((k - 1 - j.val : ℕ) : ℝ) - D ≤ ((univ.filter (fun i ↦ j < band i)).card : ℝ)) (htotal : (k : ℝ) - D ≤ Fintype.card ι) : (∑ x : ∀ i, DyadicPrimeMark A (band i).val with volume.real (finiteIntervalSupport (finiteSubsetSumAtom (fun i (p : DyadicPrimeMark A (band i).val) ↦ log (p : ℕ)) x) d) < (A * (2 : ℝ) ^ k) / (L * dyadicPrimeEnergyConstant b eps D), finiteProductWeight (fun i ↦ dyadicPrimeMarkWeight A (band i).val) x) ≤ 1 / L := by classical let mark := fun i (p : DyadicPrimeMark A (band i).val) ↦ log (p : ℕ) let w := fun i ↦ dyadicPrimeMarkWeight A (band i).val let X : ℝ := A * (2 : ℝ) ^ k let C : ℝ := dyadicPrimeEnergyConstant b eps D have hX : 0 < X := by dsimp [X] positivity [(log_pos (by norm_num : (1 : ℝ) < 2)).trans_le ha] have hC : 0 < C := dyadicPrimeEnergyConstant_pos hb heps have hW : ∀ x : ∀ i, DyadicPrimeMark A (band i).val, 0 ≤ finiteProductWeight w x := finiteProductWeight_nonneg (fun i ↦ (dyadicPrimeMarkWeight_normalized ha hlarge (band i).val).1) have henergy : (∑ x : ∀ i, DyadicPrimeMark A (band i).val, finiteProductWeight w x * finiteSubsetSumEnergy mark x d) ≤ C / X := dyadicPrimeMark_expected_energy_bound band ha hlarge hb hd hscale heps hbarrier htotal have hbad := finite_support_bad_weight_le univ (finiteProductWeight w) (fun x ↦ finiteSubsetSumEnergy mark x d) (fun x ↦ volume.real (finiteIntervalSupport (finiteSubsetSumAtom mark x) d)) hL (div_pos hC hX) (fun x _ ↦ hW x) (fun x _ ↦ finiteSubsetSumEnergy_nonneg mark x d) (fun _ _ ↦ measureReal_nonneg) (fun x _ ↦ finiteSubsetSum_support_energy mark x (zero_lt_one.trans_le hd)) henergy have hthreshold : 1 / (L * (C / X)) = X / (L * C) := by field_simp rw [hthreshold] at hbad exact hbad /-- Independent prime marks indexed by the selected count in each band. -/ abbrev DyadicCountPrimeMarks (A : ℝ) (k : ℕ) (T : Finset ℕ) : Type := ∀ i : DyadicCountCoordinate A k T, DyadicPrimeMark A (dyadicCountCoordinateBand i).val /-- The reverse barrier for an actual selected prime set gives the iid expected-energy bound for its count-vector coordinate type. -/ theorem dyadicCountPrimeMark_expected_energy_bound {A b d v : ℝ} {k D : ℕ} {T : Finset ℕ} (ha : log 2 ≤ A) (hlarge : 4 * mertensErrorConstant ≤ A * log 2) (hb : 0 < b) (hd : 1 ≤ d) (hscale : b * A ≤ d) (hv : 1 < v) (hgood : ¬ ReverseCountBarrierFailure k v D (dyadicPrimeTail A k) T) : (∑ x : DyadicCountPrimeMarks A k T, finiteProductWeight (fun i : DyadicCountCoordinate A k T ↦ dyadicPrimeMarkWeight A (dyadicCountCoordinateBand i).val) x * finiteSubsetSumEnergy (fun i (p : DyadicPrimeMark A (dyadicCountCoordinateBand i).val) ↦ log (p : ℕ)) x d) ≤ dyadicPrimeEnergyConstant b (v - 1) (D : ℝ) / (A * (2 : ℝ) ^ k) := by have hA : 0 < A := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le ha obtain ⟨heps, hbarrier, htotal⟩ := dyadicCountCoordinate_barrier_conditions hA hv hgood exact dyadicPrimeMark_expected_energy_bound (dyadicCountCoordinateBand (A := A) (k := k) (T := T)) ha hlarge hb hd hscale heps hbarrier htotal /-- Arbitrarily small iid bad-support weight, for the count vector of an actual prime selection satisfying the reverse barrier. -/ theorem dyadicCountPrimeMark_bad_support_weight_le {A b d v L : ℝ} {k D : ℕ} {T : Finset ℕ} (ha : log 2 ≤ A) (hlarge : 4 * mertensErrorConstant ≤ A * log 2) (hb : 0 < b) (hd : 1 ≤ d) (hscale : b * A ≤ d) (hv : 1 < v) (hL : 0 < L) (hgood : ¬ ReverseCountBarrierFailure k v D (dyadicPrimeTail A k) T) : (∑ x : DyadicCountPrimeMarks A k T with volume.real (finiteIntervalSupport (finiteSubsetSumAtom (fun i (p : DyadicPrimeMark A (dyadicCountCoordinateBand i).val) ↦ log (p : ℕ)) x) d) < (A * (2 : ℝ) ^ k) / (L * dyadicPrimeEnergyConstant b (v - 1) (D : ℝ)), finiteProductWeight (fun i : DyadicCountCoordinate A k T ↦ dyadicPrimeMarkWeight A (dyadicCountCoordinateBand i).val) x) ≤ 1 / L := by have hA : 0 < A := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le ha obtain ⟨heps, hbarrier, htotal⟩ := dyadicCountCoordinate_barrier_conditions hA hv hgood exact dyadicPrimeMark_bad_support_weight_le (dyadicCountCoordinateBand (A := A) (k := k) (T := T)) ha hlarge hb hd hscale heps hL hbarrier htotal end Erdos859Verification end /- Inlined development module: PrimeCountFibers.lean -/ section /- The regularity and reverse-barrier events are determined by band counts. -/ open Finset namespace Erdos859Verification noncomputable def dyadicCountVector (A : ℝ) (k : ℕ) (T : Finset ℕ) : Fin k → ℕ := fun j ↦ (T ∩ dyadicPrimeBand A j.val).card theorem dyadicPrimeTail_count_congr {A : ℝ} (hA : 0 < A) {k : ℕ} {S T : Finset ℕ} (hcount : dyadicCountVector A k S = dyadicCountVector A k T) (ell : ℕ) : (S ∩ dyadicPrimeTail A k ell).card = (T ∩ dyadicPrimeTail A k ell).card := by rw [card_inter_dyadicPrimeTail hA, card_inter_dyadicPrimeTail hA] apply sum_congr rfl intro j hj exact congrFun hcount ⟨j, (Finset.mem_Ico.mp hj).2⟩ theorem primeCountRegularity_congr_countVector {A : ℝ} {k : ℕ} {S T : Finset ℕ} (hcount : dyadicCountVector A k S = dyadicCountVector A k T) : primeCountRegularity A k (dyadicPrimeBand A) S = primeCountRegularity A k (dyadicPrimeBand A) T := by unfold primeCountRegularity apply sum_congr rfl intro j hj rw [show (S ∩ dyadicPrimeBand A j).card = (T ∩ dyadicPrimeBand A j).card from congrFun hcount ⟨j, Finset.mem_range.mp hj⟩] theorem reverseCountBarrierFailure_congr_countVector {A : ℝ} (hA : 0 < A) {k D : ℕ} {v : ℝ} {S T : Finset ℕ} (hcount : dyadicCountVector A k S = dyadicCountVector A k T) : ReverseCountBarrierFailure k v D (dyadicPrimeTail A k) S ↔ ReverseCountBarrierFailure k v D (dyadicPrimeTail A k) T := by unfold ReverseCountBarrierFailure simp_rw [dyadicPrimeTail_count_congr hA hcount] theorem dyadicCountFailure_congr_countVector {A : ℝ} (hA : 0 < A) {k D : ℕ} {v r0 : ℝ} {S T : Finset ℕ} (hcount : dyadicCountVector A k S = dyadicCountVector A k T) : DyadicCountFailure A k v r0 D S ↔ DyadicCountFailure A k v r0 D T := by unfold DyadicCountFailure rw [reverseCountBarrierFailure_congr_countVector hA hcount, primeCountRegularity_congr_countVector hcount] end Erdos859Verification end /- Inlined development module: FiniteConditionalBounds.lean -/ section /- Finite conditional estimates, including fibers of zero weight. -/ namespace Erdos859Verification open Finset theorem mass_bound_of_conditional_ratio {a b q : ℝ} (ha : 0 ≤ a) (hab : a ≤ b) (hcond : 0 < b → a / b ≤ q) : a ≤ q * b := by by_cases hb : b = 0 · rw [hb, mul_zero] exact hab.trans_eq hb · have hbpos : 0 < b := lt_of_le_of_ne (ha.trans hab) (Ne.symm hb) exact (div_le_iff₀ hbpos).mp (hcond hbpos) theorem sum_good_fiber_weights {α β : Type*} [DecidableEq α] [DecidableEq β] (S : Finset α) (f : α → β) (Good : β → Prop) [DecidablePred Good] (w : α → ℝ) : (∑ b ∈ (S.image f).filter Good, ∑ x ∈ S.filter (fun x ↦ f x = b), w x) = ∑ x ∈ S.filter (fun x ↦ Good (f x)), w x := by have h := sum_fiberwise_eq_sum_filter S ((S.image f).filter Good) f w have heq : S.filter (fun x ↦ f x ∈ (S.image f).filter Good) = S.filter (fun x ↦ Good (f x)) := by ext x by_cases hx : x ∈ S · simp only [mem_filter, hx, mem_image_of_mem f hx, true_and] · simp [hx] rwa [heq] at h theorem sum_good_bad_fiber_weights {α β : Type*} [DecidableEq α] [DecidableEq β] (S : Finset α) (f : α → β) (Good : β → Prop) [DecidablePred Good] (Bad : α → Prop) [DecidablePred Bad] (w : α → ℝ) : (∑ b ∈ (S.image f).filter Good, ∑ x ∈ S.filter (fun x ↦ f x = b ∧ Bad x), w x) = ∑ x ∈ S.filter (fun x ↦ Good (f x) ∧ Bad x), w x := by have h := sum_fiberwise_eq_sum_filter (S.filter Bad) ((S.image f).filter Good) f w have hfiber (b : β) : (S.filter Bad).filter (fun x ↦ f x = b) = S.filter (fun x ↦ f x = b ∧ Bad x) := by ext x simp [and_left_comm, and_assoc, and_comm] have heq : (S.filter Bad).filter (fun x ↦ f x ∈ (S.image f).filter Good) = S.filter (fun x ↦ Good (f x) ∧ Bad x) := by ext x by_cases hx : x ∈ S · simp only [mem_filter, hx, mem_image_of_mem f hx, true_and, and_comm] · simp [hx] simp_rw [hfiber] at h rwa [heq] at h theorem finite_good_bad_mass_le_good_mass {α β : Type*} [DecidableEq α] [DecidableEq β] (S : Finset α) (w : α → ℝ) (hw : ∀ x ∈ S, 0 ≤ w x) (f : α → β) (Good : β → Prop) [DecidablePred Good] (Bad : α → Prop) [DecidablePred Bad] {q : ℝ} (hcond : ∀ b ∈ S.image f, Good b → 0 < ∑ x ∈ S.filter (fun x ↦ f x = b), w x → (∑ x ∈ S.filter (fun x ↦ f x = b ∧ Bad x), w x) / (∑ x ∈ S.filter (fun x ↦ f x = b), w x) ≤ q) : (∑ x ∈ S.filter (fun x ↦ Good (f x) ∧ Bad x), w x) ≤ q * ∑ x ∈ S.filter (fun x ↦ Good (f x)), w x := by rw [← sum_good_bad_fiber_weights S f Good Bad w, ← sum_good_fiber_weights S f Good w, mul_sum] apply sum_le_sum intro b hb apply mass_bound_of_conditional_ratio · exact sum_nonneg (fun x hx ↦ hw x (mem_filter.mp hx).1) · apply sum_le_sum_of_subset_of_nonneg · intro x hx exact mem_filter.mpr ⟨(mem_filter.mp hx).1, (mem_filter.mp hx).2.1⟩ · intro x hx _ exact hw x (mem_filter.mp hx).1 · exact hcond b (mem_filter.mp hb).1 (mem_filter.mp hb).2 theorem finite_good_bad_mass_le_total {α β : Type*} [DecidableEq α] [DecidableEq β] (S : Finset α) (w : α → ℝ) (hw : ∀ x ∈ S, 0 ≤ w x) (f : α → β) (Good : β → Prop) [DecidablePred Good] (Bad : α → Prop) [DecidablePred Bad] {q : ℝ} (hq : 0 ≤ q) (hcond : ∀ b ∈ S.image f, Good b → 0 < ∑ x ∈ S.filter (fun x ↦ f x = b), w x → (∑ x ∈ S.filter (fun x ↦ f x = b ∧ Bad x), w x) / (∑ x ∈ S.filter (fun x ↦ f x = b), w x) ≤ q) : (∑ x ∈ S.filter (fun x ↦ Good (f x) ∧ Bad x), w x) ≤ q * ∑ x ∈ S, w x := by calc _ ≤ q * ∑ x ∈ S.filter (fun x ↦ Good (f x)), w x := finite_good_bad_mass_le_good_mass S w hw f Good Bad hcond _ ≤ _ := mul_le_mul_of_nonneg_left (sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun x hx _ ↦ hw x hx)) hq theorem finite_good_bad_mass_le {α β : Type*} [DecidableEq α] [DecidableEq β] (S : Finset α) (w : α → ℝ) (hw : ∀ x ∈ S, 0 ≤ w x) (hnorm : ∑ x ∈ S, w x = 1) (f : α → β) (Good : β → Prop) [DecidablePred Good] (Bad : α → Prop) [DecidablePred Bad] {q : ℝ} (hq : 0 ≤ q) (hcond : ∀ b ∈ S.image f, Good b → 0 < ∑ x ∈ S.filter (fun x ↦ f x = b), w x → (∑ x ∈ S.filter (fun x ↦ f x = b ∧ Bad x), w x) / (∑ x ∈ S.filter (fun x ↦ f x = b), w x) ≤ q) : (∑ x ∈ S.filter (fun x ↦ Good (f x) ∧ Bad x), w x) ≤ q := by simpa only [hnorm, mul_one] using finite_good_bad_mass_le_total S w hw f Good Bad hq hcond theorem finite_good_outcome_mass_lower_unnormalized {α β : Type*} [DecidableEq α] [DecidableEq β] (S : Finset α) (w : α → ℝ) (hw : ∀ x ∈ S, 0 ≤ w x) (f : α → β) (Good : β → Prop) [DecidablePred Good] (Bad : α → Prop) [DecidablePred Bad] {q r : ℝ} (hq : 0 ≤ q) (hclass : (∑ x ∈ S.filter (fun x ↦ ¬ Good (f x)), w x) ≤ r) (hcond : ∀ b ∈ S.image f, Good b → 0 < ∑ x ∈ S.filter (fun x ↦ f x = b), w x → (∑ x ∈ S.filter (fun x ↦ f x = b ∧ Bad x), w x) / (∑ x ∈ S.filter (fun x ↦ f x = b), w x) ≤ q) : (1 - q) * (∑ x ∈ S, w x) - r ≤ ∑ x ∈ S.filter (fun x ↦ Good (f x) ∧ ¬ Bad x), w x := by have hbad := finite_good_bad_mass_le_total S w hw f Good Bad hq hcond have hsplit : (∑ x ∈ S.filter (fun x ↦ ¬ Good (f x)), w x) + (∑ x ∈ S.filter (fun x ↦ Good (f x) ∧ Bad x), w x) + (∑ x ∈ S.filter (fun x ↦ Good (f x) ∧ ¬ Bad x), w x) = ∑ x ∈ S, w x := by simp only [sum_filter] rw [← sum_add_distrib, ← sum_add_distrib] apply sum_congr rfl intro x _ by_cases hg : Good (f x) <;> by_cases hb : Bad x <;> simp [hg, hb] nlinarith theorem finite_good_outcome_mass_lower {α β : Type*} [DecidableEq α] [DecidableEq β] (S : Finset α) (w : α → ℝ) (hw : ∀ x ∈ S, 0 ≤ w x) (hnorm : ∑ x ∈ S, w x = 1) (f : α → β) (Good : β → Prop) [DecidablePred Good] (Bad : α → Prop) [DecidablePred Bad] {q r : ℝ} (hq : 0 ≤ q) (hclass : (∑ x ∈ S.filter (fun x ↦ ¬ Good (f x)), w x) ≤ r) (hcond : ∀ b ∈ S.image f, Good b → 0 < ∑ x ∈ S.filter (fun x ↦ f x = b), w x → (∑ x ∈ S.filter (fun x ↦ f x = b ∧ Bad x), w x) / (∑ x ∈ S.filter (fun x ↦ f x = b), w x) ≤ q) : 1 - r - q ≤ ∑ x ∈ S.filter (fun x ↦ Good (f x) ∧ ¬ Bad x), w x := by have h := finite_good_outcome_mass_lower_unnormalized S w hw f Good Bad hq hclass hcond rw [hnorm, mul_one] at h linarith end Erdos859Verification end /- Inlined development module: FiniteSubsetSupport.lean -/ section /- Canonical thickened subset-sum supports and distinct prime tuples. -/ open Finset Real MeasureTheory namespace Erdos859Verification noncomputable def primeSubsetSumSupport (T : Finset ℕ) (d : ℝ) : Set ℝ := finiteIntervalSupport (fun U : T.powerset ↦ ∑ p ∈ (U : Finset ℕ), log (p : ℝ)) d theorem mem_primeSubsetSumSupport {T : Finset ℕ} {d y : ℝ} : y ∈ primeSubsetSumSupport T d ↔ ∃ U : Finset ℕ, U ⊆ T ∧ y ∈ Set.Icc (∑ p ∈ U, log (p : ℝ)) ((∑ p ∈ U, log (p : ℝ)) + d) := by constructor · intro hy obtain ⟨U, hU⟩ := Set.mem_iUnion.mp hy exact ⟨U.val, mem_powerset.mp U.property, hU⟩ · rintro ⟨U, hU, hy⟩ exact Set.mem_iUnion.mpr ⟨⟨U, mem_powerset.mpr hU⟩, hy⟩ theorem isCompact_primeSubsetSumSupport (T : Finset ℕ) (d : ℝ) : IsCompact (primeSubsetSumSupport T d) := isCompact_finiteIntervalSupport _ _ theorem primeSubsetSumSupport_mono {S T : Finset ℕ} (hST : S ⊆ T) (d : ℝ) : primeSubsetSumSupport S d ⊆ primeSubsetSumSupport T d := by intro y hy obtain ⟨U, hUS, hUy⟩ := mem_primeSubsetSumSupport.mp hy exact mem_primeSubsetSumSupport.mpr ⟨U, hUS.trans hST, hUy⟩ /-- Every subset sum lies between zero and the total logarithmic sum. Natural-number logarithms are nonnegative, so no primality hypothesis is needed. -/ theorem primeSubsetSumSupport_subset_Icc (T : Finset ℕ) (d : ℝ) : primeSubsetSumSupport T d ⊆ Set.Icc 0 ((∑ p ∈ T, log (p : ℝ)) + d) := by intro y hy obtain ⟨U, hUT, hyU⟩ := mem_primeSubsetSumSupport.mp hy have hnonneg : 0 ≤ ∑ p ∈ U, log (p : ℝ) := sum_nonneg (fun p _ ↦ Real.log_natCast_nonneg p) have hsum : (∑ p ∈ U, log (p : ℝ)) ≤ ∑ p ∈ T, log (p : ℝ) := sum_le_sum_of_subset_of_nonneg hUT (fun p _ _ ↦ Real.log_natCast_nonneg p) exact ⟨hnonneg.trans hyU.1, by linarith [hyU.2]⟩ theorem primeSubsetSumSupport_subset_Icc_of_sum_bound (T : Finset ℕ) (d L : ℝ) (hbound : (∑ p ∈ T, log (p : ℝ)) + d ≤ L) : primeSubsetSumSupport T d ⊆ Set.Icc 0 L := (primeSubsetSumSupport_subset_Icc T d).trans (Set.Icc_subset_Icc le_rfl hbound) theorem primeSubsetSumSupport_inter_Icc_eq (T : Finset ℕ) (d L : ℝ) (hbound : (∑ p ∈ T, log (p : ℝ)) + d ≤ L) : primeSubsetSumSupport T d ∩ Set.Icc 0 L = primeSubsetSumSupport T d := Set.inter_eq_left.mpr (primeSubsetSumSupport_subset_Icc_of_sum_bound T d L hbound) theorem primeSubsetSumSupport_inter_measure_mono (d : ℝ) (K : Set ℝ) : Monotone (fun T : Finset ℕ ↦ volume.real (primeSubsetSumSupport T d ∩ K)) := by intro S T hST exact measureReal_mono (Set.inter_subset_inter (primeSubsetSumSupport_mono hST d) Set.Subset.rfl) (measure_ne_top_of_subset Set.inter_subset_left (isCompact_primeSubsetSumSupport T d).measure_ne_top) /-- The large-support indicator is increasing, as required for finite FKG. -/ theorem primeSubsetSumSupport_large_indicator_monotone (d r : ℝ) (K : Set ℝ) : Monotone (fun T : Finset ℕ ↦ if r ≤ volume.real (primeSubsetSumSupport T d ∩ K) then (1 : ℝ) else 0) := by intro S T hST by_cases hS : r ≤ volume.real (primeSubsetSumSupport S d ∩ K) · have hT := hS.trans (primeSubsetSumSupport_inter_measure_mono d K hST) simp only [if_pos hS, if_pos hT, le_refl] · simp only [if_neg hS] split_ifs <;> norm_num /-- Reindexing coordinates preserves the complete fair-bit subset-sum support, including multiplicities of coincident mark values. -/ theorem finite_bitSum_support_reindex {ι κ : Type*} [Fintype ι] [Fintype κ] (e : ι ≃ κ) (v : κ → ℝ) (d : ℝ) : finiteIntervalSupport (fun b : ι → Bool ↦ ∑ i, if b i then v (e i) else 0) d = finiteIntervalSupport (fun b : κ → Bool ↦ ∑ j, if b j then v j else 0) d := by apply Set.Subset.antisymm · apply finiteIntervalSupport_mono_range rintro s ⟨b, rfl⟩ refine ⟨fun j ↦ b (e.symm j), ?_⟩ have hsum := e.sum_comp (fun j ↦ if b (e.symm j) then v j else 0) simpa using hsum.symm · apply finiteIntervalSupport_mono_range rintro s ⟨b, rfl⟩ exact ⟨fun i ↦ b (e i), e.sum_comp (fun j ↦ if b j then v j else 0)⟩ /-- Distinct coordinate labels turn indexed bit choices into subsets of the finite image. Injectivity is essential: repeated labels can be used twice by indexed bit choices but occur only once in the image finset. -/ theorem finite_bitSum_support_eq_primeSubsetSumSupport {ι : Type*} [Fintype ι] [DecidableEq ι] (f : ι → ℕ) (hf : Function.Injective f) (d : ℝ) : finiteIntervalSupport (fun b : ι → Bool ↦ ∑ i, if b i then log (f i : ℝ) else 0) d = primeSubsetSumSupport (univ.image f) d := by classical ext y constructor · intro hy obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hy let I : Finset ι := univ.filter (fun i ↦ b i) have hI : I.image f ⊆ univ.image f := image_subset_image (filter_subset _ _) have hsum : (∑ p ∈ I.image f, log (p : ℝ)) = ∑ i, if b i then log (f i : ℝ) else 0 := by rw [sum_image (fun i _ j _ hij ↦ hf hij)] exact sum_filter _ _ apply mem_primeSubsetSumSupport.mpr refine ⟨I.image f, hI, ?_⟩ simpa only [hsum] using hb · intro hy obtain ⟨U, hU, hyU⟩ := mem_primeSubsetSumSupport.mp hy let b : ι → Bool := fun i ↦ decide (f i ∈ U) let I : Finset ι := univ.filter (fun i ↦ f i ∈ U) have himage : I.image f = U := by ext p constructor · intro hp obtain ⟨i, hi, rfl⟩ := mem_image.mp hp exact (mem_filter.mp hi).2 · intro hp obtain ⟨i, hi, hfi⟩ := mem_image.mp (hU hp) exact mem_image.mpr ⟨i, mem_filter.mpr ⟨hi, by simpa only [hfi] using hp⟩, hfi⟩ have hsum : (∑ i, if b i then log (f i : ℝ) else 0) = ∑ p ∈ U, log (p : ℝ) := by rw [← himage, sum_image (fun i _ j _ hij ↦ hf hij)] simp [I, b, sum_filter] exact Set.mem_iUnion.mpr ⟨b, by simpa only [hsum] using hyU⟩ theorem finiteSubsetSumAtom_prime_support {ι : Type*} [Fintype ι] [DecidableEq ι] (f : ι → ℕ) (hf : Function.Injective f) (d : ℝ) : finiteIntervalSupport (finiteSubsetSumAtom (fun _ (p : ℕ) ↦ log (p : ℝ)) f) d = primeSubsetSumSupport (univ.image f) d := finite_bitSum_support_eq_primeSubsetSumSupport f hf d def bandTuplePrimeMap {ι : Type*} {P : ι → Finset ℕ} {n : ι → ℕ} (x : BandTuple P n) (ji : Sigma (fun j ↦ Fin (n j))) : ℕ := (x ji.1 ji.2).val theorem bandTuplePrimeMap_injective {ι : Type*} {P : ι → Finset ℕ} {n : ι → ℕ} (hdis : Pairwise (fun j k ↦ Disjoint (P j) (P k))) (x : BandTuple P n) (hx : BandTupleDistinct x) : Function.Injective (bandTuplePrimeMap x) := by rintro ⟨j, i⟩ ⟨k, l⟩ heq change (x j i).val = (x k l).val at heq have hjk : j = k := by by_contra hne apply disjoint_left.mp (hdis hne) (x j i).property rw [heq] exact (x k l).property subst k have hil : i = l := hx j (Subtype.ext heq) subst l rfl theorem image_bandTuplePrimeMap {ι : Type*} [Fintype ι] {P : ι → Finset ℕ} {n : ι → ℕ} (x : BandTuple P n) : univ.image (bandTuplePrimeMap x) = primeBandUnion (bandTupleSupport x) := by ext p simp [bandTuplePrimeMap, primeBandUnion, bandTupleSupport, tupleSupport] /-- On distinct tuples from disjoint bands, the thickened fair subset-sum support is exactly the canonical support of the union of selected primes. -/ theorem distinct_bandTuple_subsetSum_support {ι : Type*} [Fintype ι] [DecidableEq ι] {P : ι → Finset ℕ} {n : ι → ℕ} (hdis : Pairwise (fun j k ↦ Disjoint (P j) (P k))) (x : BandTuple P n) (hx : BandTupleDistinct x) (d : ℝ) : finiteIntervalSupport (finiteSubsetSumAtom (fun (ji : Sigma (fun j ↦ Fin (n j))) (p : P ji.1) ↦ log (p : ℕ)) (bandTupleSigmaEquiv P n x)) d = primeSubsetSumSupport (primeBandUnion (bandTupleSupport x)) d := by have h := finiteSubsetSumAtom_prime_support (bandTuplePrimeMap x) (bandTuplePrimeMap_injective hdis x hx) d have hatom : finiteSubsetSumAtom (fun (ji : Sigma (fun j ↦ Fin (n j))) (p : P ji.1) ↦ log (p : ℕ)) (bandTupleSigmaEquiv P n x) = finiteSubsetSumAtom (fun _ (p : ℕ) ↦ log (p : ℝ)) (bandTuplePrimeMap x) := by funext b rfl rw [hatom] simpa only [image_bandTuplePrimeMap] using h end Erdos859Verification end /- Inlined development module: PrimeConditionalSupport.lean -/ section /- Support bounds for the exact prime law conditioned on its band counts. -/ open Finset Real MeasureTheory namespace Erdos859Verification theorem primeBandUnion_dyadic (A : ℝ) (k : ℕ) : primeBandUnion (fun j : Fin k ↦ dyadicPrimeBand A j.val) = dyadicPrimeUniverse A k := by ext p constructor · intro hp obtain ⟨j, _, hpj⟩ := Finset.mem_biUnion.mp hp exact Finset.mem_biUnion.mpr ⟨j.val, Finset.mem_range.mpr j.isLt, hpj⟩ · intro hp obtain ⟨j, hj, hpj⟩ := Finset.mem_biUnion.mp hp exact Finset.mem_biUnion.mpr ⟨⟨j, Finset.mem_range.mp hj⟩, Finset.mem_univ _, hpj⟩ theorem primeBandCountRegularity_dyadic (A : ℝ) (k : ℕ) (T : Finset ℕ) : primeBandCountRegularity (fun j : Fin k ↦ A * (2 : ℝ) ^ j.val) (fun j ↦ (T ∩ dyadicPrimeBand A j.val).card) = primeCountRegularity A k (dyadicPrimeBand A) T := by simpa only [primeBandCountRegularity, primeCountRegularity, neg_mul] using Fin.sum_univ_eq_sum_range (fun j : ℕ ↦ ((T ∩ dyadicPrimeBand A j).card : ℝ) ^ 2 * exp (-(A * (2 : ℝ) ^ j))) k /-- The finite fiber of all selections having the same band counts as `T`. -/ noncomputable def dyadicCountFiber (A : ℝ) (k : ℕ) (T : Finset ℕ) : Finset (Finset ℕ) := (dyadicPrimeUniverse A k).powerset.filter (fun U ↦ ∀ j : Fin k, (U ∩ dyadicPrimeBand A j.val).card = (T ∩ dyadicPrimeBand A j.val).card) /-- Within a regular count fiber, small canonical subset-sum support has conditional weight at most `2 / L`. The factor two is paid once for the complete tuple law across all bands. -/ theorem dyadicPrime_conditional_bad_support_weight_le {A b d v L lam : ℝ} {k D : ℕ} {T : Finset ℕ} (ha : log 2 ≤ A) (hlarge : 4 * mertensErrorConstant ≤ A * log 2) (hb : 0 < b) (hd : 1 ≤ d) (hscale : b * A ≤ d) (hv : 1 < v) (hL : 0 < L) (hlam : 0 < lam) (hgood : ¬ ReverseCountBarrierFailure k v D (dyadicPrimeTail A k) T) (hreg : primeCountRegularity A k (dyadicPrimeBand A) T ≤ primeMarkRegularityCutoff) : (∑ U ∈ dyadicCountFiber A k T with volume.real (primeSubsetSumSupport U d) < (A * (2 : ℝ) ^ k) / (L * dyadicPrimeEnergyConstant b (v - 1) (D : ℝ)), primeTiltWeight (dyadicPrimeUniverse A k) lam U) / (∑ U ∈ dyadicCountFiber A k T, primeTiltWeight (dyadicPrimeUniverse A k) lam U) ≤ 2 / L := by classical let P : Fin k → Finset ℕ := fun j ↦ dyadicPrimeBand A j.val let n : Fin k → ℕ := fun j ↦ (T ∩ P j).card let a : Fin k → ℝ := fun j ↦ A * (2 : ℝ) ^ j.val let M : Fin k → ℝ := fun j ↦ primeLogWindowMass (a j) (2 * a j) let threshold : ℝ := (A * (2 : ℝ) ^ k) / (L * dyadicPrimeEnergyConstant b (v - 1) (D : ℝ)) let F : (Fin k → Finset ℕ) → ℝ := fun U ↦ if volume.real (primeSubsetSumSupport (primeBandUnion U) d) < threshold then 1 else 0 let w := fun i : DyadicCountCoordinate A k T ↦ dyadicPrimeMarkWeight A (dyadicCountCoordinateBand i).val let mark := fun (i : DyadicCountCoordinate A k T) (p : DyadicPrimeMark A (dyadicCountCoordinateBand i).val) ↦ log (p : ℕ) let H : DyadicCountPrimeMarks A k T → ℝ := fun x ↦ if volume.real (finiteIntervalSupport (finiteSubsetSumAtom mark x) d) < threshold then 1 else 0 let G : BandTuple P n → ℝ := fun x ↦ H (bandTupleSigmaEquiv P n x) have hA : 0 < A := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le ha have hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j)) := by intro i j hij apply dyadicPrimeBand_pairwise_disjoint hA exact fun h ↦ hij (Fin.ext h) have hP : ∀ j p, p ∈ P j → p.Prime := fun j ↦ dyadicPrimeBand_prime A j.val have haBand : ∀ j, log 2 ≤ a j := fun j ↦ (dyadicPrimeMark_scale_conditions ha hlarge j.val).1 have hlargeBand : ∀ j, 4 * mertensErrorConstant ≤ a j * log 2 := fun j ↦ (dyadicPrimeMark_scale_conditions ha hlarge j.val).2 have hM : ∀ j, 0 < M j := by intro j exact (half_pos (log_pos (by norm_num : (1 : ℝ) < 2))).trans_le (primeLogWindowMass_dyadic_lower (haBand j) (hlargeBand j)) have hreg' : primeBandCountRegularity a n ≤ primeMarkRegularityCutoff := by rw [show primeBandCountRegularity a n = primeCountRegularity A k (dyadicPrimeBand A) T from primeBandCountRegularity_dyadic A k T] exact hreg have hratio := regular_primeBand_likelihood_bound a n hreg' have hmass := regular_primeBand_distinct_mass a n haBand hlargeBand hreg' have hG : ∀ x, 0 ≤ G x := by intro x dsimp [G, H] split_ifs <;> norm_num have hmatch : ∀ x ∈ distinctBandTuples P n, F (bandTupleSupport x) = G x := by intro x hx have hx' : BandTupleDistinct x := by simpa only [distinctBandTuples, Finset.mem_filter, Finset.mem_univ, true_and] using hx have hs := distinct_bandTuple_subsetSum_support hdis x hx' d exact congrArg (fun S : Set ℝ ↦ if volume.real S < threshold then (1 : ℝ) else 0) hs.symm have hlog : ∀ j p, p ∈ P j → a j ≤ log (p : ℝ) := by intro j p hp exact (mem_dyadicPrimeBand.mp hp).2.1.le have hc := ambient_primeTilt_fixedCounts_expectation_le_two_iid_extension P hdis hP hlam M hM n F G hG hmatch a hlog hratio hmass have hIid : (∑ x : BandTuple P n, bandReciprocalTupleWeight M x * G x) ≤ 1 / L := by have hsum : (∑ x : BandTuple P n, bandReciprocalTupleWeight M x * G x) = ∑ x : DyadicCountPrimeMarks A k T, finiteProductWeight w x * H x := by calc _ = ∑ x : BandTuple P n, finiteProductWeight w (bandTupleSigmaEquiv P n x) * H (bandTupleSigmaEquiv P n x) := by apply sum_congr rfl intro x _ rw [bandReciprocalTupleWeight_eq_sigma] rfl _ = _ := (bandTupleSigmaEquiv P n).sum_comp (fun x ↦ finiteProductWeight w x * H x) rw [hsum] have hi := dyadicCountPrimeMark_bad_support_weight_le ha hlarge hb hd hscale hv hL hgood simpa only [H, w, mark, threshold, sum_filter, mul_ite, mul_one, mul_zero] using hi have hUnion : primeBandUnion P = dyadicPrimeUniverse A k := primeBandUnion_dyadic A k rw [hUnion] at hc have hc' : (∑ U ∈ dyadicCountFiber A k T, primeTiltWeight (dyadicPrimeUniverse A k) lam U * F (fun j ↦ U ∩ P j)) / (∑ U ∈ dyadicCountFiber A k T, primeTiltWeight (dyadicPrimeUniverse A k) lam U) ≤ 2 * ∑ x : BandTuple P n, bandReciprocalTupleWeight M x * G x := by simpa only [dyadicCountFiber, P, n, Finset.sum_filter] using hc have hnum : (∑ U ∈ dyadicCountFiber A k T, primeTiltWeight (dyadicPrimeUniverse A k) lam U * F (fun j ↦ U ∩ P j)) = ∑ U ∈ dyadicCountFiber A k T with volume.real (primeSubsetSumSupport U d) < threshold, primeTiltWeight (dyadicPrimeUniverse A k) lam U := by rw [sum_filter] apply sum_congr rfl intro U hU have hUsub : U ⊆ primeBandUnion P := by rw [hUnion] have hU' := hU simp only [dyadicCountFiber, Finset.mem_filter, Finset.mem_powerset] at hU' exact hU'.1 have hu : primeBandUnion (fun j ↦ U ∩ P j) = U := primeBand_intersections_union P hUsub dsimp [F] rw [hu] split_ifs <;> simp rw [hnum] at hc' exact hc'.trans ((mul_le_mul_of_nonneg_left hIid (by norm_num)).trans_eq (by ring)) end Erdos859Verification end /- Inlined development module: DyadicConditionalAssembly.lean -/ section /- Conditional estimates on count fibers yield actual prime-law bounds. -/ open Finset namespace Erdos859Verification theorem dyadic_count_conditional_bad_mass_le {A lam v r0 q : ℝ} (hA : 0 < A) {k D : ℕ} {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hlam : 0 < lam) (hq : 0 ≤ q) (Bad : Finset ℕ → Prop) [DecidablePred Bad] (hcond : ∀ T ∈ P.powerset, ¬ DyadicCountFailure A k v r0 D T → (∑ U ∈ P.powerset with dyadicCountVector A k U = dyadicCountVector A k T ∧ Bad U, primeTiltWeight P lam U) / (∑ U ∈ P.powerset with dyadicCountVector A k U = dyadicCountVector A k T, primeTiltWeight P lam U) ≤ q) : (∑ U ∈ P.powerset with ¬ DyadicCountFailure A k v r0 D U ∧ Bad U, primeTiltWeight P lam U) ≤ q := by classical let Good : (Fin k → ℕ) → Prop := fun n ↦ ∃ T ∈ P.powerset, dyadicCountVector A k T = n ∧ ¬ DyadicCountFailure A k v r0 D T have hevent (T : Finset ℕ) (hT : T ∈ P.powerset) : Good (dyadicCountVector A k T) ↔ ¬ DyadicCountFailure A k v r0 D T := by constructor · rintro ⟨S, _hS, hST, hgood⟩ exact fun hbad ↦ hgood ((dyadicCountFailure_congr_countVector hA hST).mpr hbad) · intro hgood exact ⟨T, hT, rfl, hgood⟩ have hbound := finite_good_bad_mass_le P.powerset (primeTiltWeight P lam) (fun T _ ↦ (primeTiltWeight_pos hP hlam T).le) (sum_primeTiltWeight hP hlam) (dyadicCountVector A k) Good Bad hq (by intro n _hn hn _hmass obtain ⟨T, hT, hcount, hgood⟩ := hn subst n exact hcond T hT hgood) have heq : P.powerset.filter (fun U ↦ Good (dyadicCountVector A k U) ∧ Bad U) = P.powerset.filter (fun U ↦ ¬ DyadicCountFailure A k v r0 D U ∧ Bad U) := by apply filter_congr intro U hU rw [hevent U hU] rwa [heq] at hbound theorem dyadic_count_good_outcome_mass_lower {A lam v r0 q r : ℝ} (hA : 0 < A) {k D : ℕ} {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hlam : 0 < lam) (hq : 0 ≤ q) (Bad : Finset ℕ → Prop) [DecidablePred Bad] (hclass : (∑ T ∈ P.powerset with DyadicCountFailure A k v r0 D T, primeTiltWeight P lam T) ≤ r) (hcond : ∀ T ∈ P.powerset, ¬ DyadicCountFailure A k v r0 D T → (∑ U ∈ P.powerset with dyadicCountVector A k U = dyadicCountVector A k T ∧ Bad U, primeTiltWeight P lam U) / (∑ U ∈ P.powerset with dyadicCountVector A k U = dyadicCountVector A k T, primeTiltWeight P lam U) ≤ q) : 1 - r - q ≤ ∑ U ∈ P.powerset with ¬ DyadicCountFailure A k v r0 D U ∧ ¬ Bad U, primeTiltWeight P lam U := by classical have hbad := dyadic_count_conditional_bad_mass_le hA hP hlam hq Bad hcond have hsplit : (∑ U ∈ P.powerset with DyadicCountFailure A k v r0 D U, primeTiltWeight P lam U) + (∑ U ∈ P.powerset with ¬ DyadicCountFailure A k v r0 D U ∧ Bad U, primeTiltWeight P lam U) + (∑ U ∈ P.powerset with ¬ DyadicCountFailure A k v r0 D U ∧ ¬ Bad U, primeTiltWeight P lam U) = 1 := by rw [← sum_primeTiltWeight hP hlam] simp only [sum_filter] rw [← sum_add_distrib, ← sum_add_distrib] apply sum_congr rfl intro U _ by_cases hg : DyadicCountFailure A k v r0 D U <;> by_cases hb : Bad U <;> simp [hg, hb] linarith end Erdos859Verification end /- Inlined development module: PrimePositiveSupport.lean -/ section /- Positive logarithmic subset-sum support under the exact finite prime law. -/ namespace Erdos859Verification open Finset Real MeasureTheory theorem dyadicPrime_good_large_support_weight {A b d v lam C0 : ℝ} {k D : ℕ} (ha : log 2 ≤ A) (hlarge : 4 * mertensErrorConstant ≤ A * log 2) (hb : 0 < b) (hd : 1 ≤ d) (hscale : b * A ≤ d) (hv : 1 < v) (hlam : 0 < lam) (hgoodmass : (5 : ℝ) / 8 ≤ ∑ T ∈ (dyadicPrimeUniverse A k).powerset.filter (DyadicGoodCounts A k v primeMarkRegularityCutoff C0 D), primeTiltWeight (dyadicPrimeUniverse A k) lam T) : (1 : ℝ) / 2 ≤ ∑ T ∈ (dyadicPrimeUniverse A k).powerset.filter (fun T ↦ DyadicGoodCounts A k v primeMarkRegularityCutoff C0 D T ∧ (A * (2 : ℝ) ^ k) / (16 * dyadicPrimeEnergyConstant b (v - 1) (D : ℝ)) ≤ volume.real (primeSubsetSumSupport T d)), primeTiltWeight (dyadicPrimeUniverse A k) lam T := by classical let P := dyadicPrimeUniverse A k let w := primeTiltWeight P lam let Bad : Finset ℕ → Prop := fun T ↦ volume.real (primeSubsetSumSupport T d) < (A * (2 : ℝ) ^ k) / (16 * dyadicPrimeEnergyConstant b (v - 1) (D : ℝ)) let Good := DyadicGoodCounts A k v primeMarkRegularityCutoff C0 D have hA : 0 < A := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le ha have hP : ∀ p ∈ P, p.Prime := dyadicPrimeUniverse_prime A k have hw : ∀ T ∈ P.powerset, 0 ≤ w T := fun T _ ↦ (primeTiltWeight_pos hP hlam T).le have hbad : (∑ T ∈ P.powerset with ¬ DyadicCountFailure A k v primeMarkRegularityCutoff D T ∧ Bad T, w T) ≤ (1 : ℝ) / 8 := by apply dyadic_count_conditional_bad_mass_le hA hP hlam (by norm_num) Bad intro T _hT hgood have hrev := (not_or.mp hgood).1 have hreg : primeCountRegularity A k (dyadicPrimeBand A) T ≤ primeMarkRegularityCutoff := (lt_of_not_ge (not_or.mp hgood).2).le have h := dyadicPrime_conditional_bad_support_weight_le (L := 16) ha hlarge hb hd hscale hv (by norm_num) hlam hrev hreg have h' := h.trans (show (2 : ℝ) / 16 ≤ 1 / 8 by norm_num) simpa only [dyadicCountFiber, dyadicCountVector, funext_iff, filter_filter] using h' have hbadGood : (∑ T ∈ P.powerset.filter Good with Bad T, w T) ≤ (1 : ℝ) / 8 := by apply le_trans _ hbad apply sum_le_sum_of_subset_of_nonneg · intro T hT obtain ⟨hTG, hBad⟩ := mem_filter.mp hT obtain ⟨hTP, hGood⟩ := mem_filter.mp hTG exact mem_filter.mpr ⟨hTP, hGood.1, hBad⟩ · intro T hT _ exact hw T (mem_filter.mp hT).1 have hsplit := sum_filter_add_sum_filter_not (P.powerset.filter Good) Bad w have hout : (1 : ℝ) / 2 ≤ ∑ T ∈ P.powerset.filter Good with ¬ Bad T, w T := by change (5 : ℝ) / 8 ≤ ∑ T ∈ P.powerset.filter Good, w T at hgoodmass linarith simpa only [filter_filter, Bad, not_lt] using hout /-- For every supercritical tilt and every fixed range of smoothing widths, a uniformly positive fraction of actual prime selections has logarithmic subset-sum support of positive relative measure in a fixed bounded interval. All probability weights here are the exact finite tilted prime law. -/ theorem exists_dyadicPrime_positive_support {lam b B : ℝ} (hcritical : 1 < lam * log 2) (hb : 0 < b) (hB : 0 < B) : ∃ c : ℝ, 0 < c ∧ ∃ C : ℝ, 0 < C ∧ ∃ A0 : ℝ, 0 < A0 ∧ ∀ A : ℝ, A0 ≤ A → ∀ k : ℕ, 1 ≤ k → ∀ d : ℝ, b * A ≤ d → d ≤ B * A → (1 : ℝ) / 2 ≤ ∑ T ∈ (dyadicPrimeUniverse A k).powerset.filter (fun T ↦ c * (A * (2 : ℝ) ^ k) ≤ volume.real (primeSubsetSumSupport T d ∩ Set.Icc 0 (C * (A * (2 : ℝ) ^ k)))), primeTiltWeight (dyadicPrimeUniverse A k) lam T := by classical have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hlam : 0 < lam := by nlinarith obtain ⟨v, hv, D, Acount, hAcount, hcounts⟩ := exists_dyadic_good_count_parameters hcritical primeMarkRegularityCutoff_pos (by norm_num : (0 : ℝ) < 1 / 8) let E := dyadicPrimeEnergyConstant b (v - 1) (D : ℝ) have hE : 0 < E := dyadicPrimeEnergyConstant_pos hb (by linarith) let C0 : ℝ := 2 * (lam * log 2 + 1) / (1 / 8) have hC0 : 0 < C0 := by dsimp [C0]; positivity let c : ℝ := 1 / (16 * E) let C : ℝ := C0 + B + 1 let A0 : ℝ := max Acount (max (log 2) (max (4 * mertensErrorConstant / log 2) (1 / b))) refine ⟨c, by dsimp [c]; positivity, C, by dsimp [C]; positivity, A0, hAcount.trans_le (le_max_left _ _), ?_⟩ intro A hA k _hk d hscale hdB have hcount : Acount ≤ A := (le_max_left _ _).trans hA have hother : max (log 2) (max (4 * mertensErrorConstant / log 2) (1 / b)) ≤ A := (le_max_right _ _).trans hA have ha : log 2 ≤ A := (le_max_left _ _).trans hother have hlarge' : 4 * mertensErrorConstant / log 2 ≤ A := (le_max_left _ _).trans ((le_max_right _ _).trans hother) have hlarge : 4 * mertensErrorConstant ≤ A * log 2 := (div_le_iff₀ hlog).mp hlarge' have hAb : 1 / b ≤ A := (le_max_right _ _).trans ((le_max_right _ _).trans hother) have hd : 1 ≤ d := by have h := (div_le_iff₀ hb).mp hAb; nlinarith have hApos : 0 < A := hAcount.trans_le hcount let X : ℝ := A * (2 : ℝ) ^ k have hX : 0 < X := by dsimp [X]; positivity have hAX : A ≤ X := by change A ≤ A * (2 : ℝ) ^ k exact le_mul_of_one_le_right hApos.le (one_le_pow₀ (by norm_num)) have hgm : (5 : ℝ) / 8 ≤ ∑ T ∈ (dyadicPrimeUniverse A k).powerset.filter (DyadicGoodCounts A k v primeMarkRegularityCutoff C0 D), primeTiltWeight (dyadicPrimeUniverse A k) lam T := by have h := (hcounts A hcount k (dyadicPrimeUniverse A k) (dyadicPrimeUniverse_prime A k) (Subset.refl _)).2 norm_num only [show (1 : ℝ) - 3 * (1 / 8) = 5 / 8 by norm_num] at h exact h have hsupport := dyadicPrime_good_large_support_weight ha hlarge hb hd hscale hv hlam hgm apply hsupport.trans apply sum_le_sum_of_subset_of_nonneg · intro T hT obtain ⟨hTP, hGood, hvolume⟩ := mem_filter.mp hT have hTsub : T ⊆ dyadicPrimeUniverse A k := mem_powerset.mp hTP have hsum : (∑ p ∈ T, log (p : ℝ)) < C0 * X := by have h := hGood.2 simpa only [dyadicSelectedLogSum, inter_eq_left.mpr hTsub] using h have hheight : (∑ p ∈ T, log (p : ℝ)) + d ≤ C * X := by have hdX : d ≤ B * X := hdB.trans (mul_le_mul_of_nonneg_left hAX hB.le) dsimp [C] nlinarith have hinter := primeSubsetSumSupport_inter_Icc_eq T d (C * X) hheight apply mem_filter.mpr refine ⟨hTP, ?_⟩ rw [hinter] have hc : c * X = X / (16 * E) := by dsimp [c]; ring rw [hc] exact hvolume · intro T hT _ exact (primeTiltWeight_pos (dyadicPrimeUniverse_prime A k) hlam T).le end Erdos859Verification end /- Inlined development module: PrimeDivisorLogSupport.lean -/ section /- Canonical prime subset sums produce logarithms of actual divisors. -/ open Finset Real MeasureTheory namespace Erdos859Verification noncomputable def divisorLogSupport (n : ℕ) (d : ℝ) : Set ℝ := finiteIntervalSupport (fun m : n.divisors ↦ log (m : ℕ)) d theorem isCompact_divisorLogSupport (n : ℕ) (d : ℝ) : IsCompact (divisorLogSupport n d) := isCompact_finiteIntervalSupport _ _ theorem primeSubsetSumSupport_subset_divisorLogSupport {T : Finset ℕ} (hT : ∀ p ∈ T, p.Prime) (d : ℝ) : primeSubsetSumSupport T d ⊆ divisorLogSupport (∏ p ∈ T, p) d := by intro y hy obtain ⟨U, hUT, hUy⟩ := mem_primeSubsetSumSupport.mp hy have hN : (∏ p ∈ T, p) ≠ 0 := Finset.prod_ne_zero_iff.mpr (fun p hp ↦ (hT p hp).ne_zero) have hdiv : (∏ p ∈ U, p) ∈ (∏ p ∈ T, p).divisors := Nat.mem_divisors.mpr ⟨prod_dvd_prod_of_subset U T (fun p ↦ p) hUT, hN⟩ have hlog : log ((∏ p ∈ U, p : ℕ) : ℝ) = ∑ p ∈ U, log (p : ℝ) := by rw [Nat.cast_prod] exact log_prod (fun p hp ↦ by exact_mod_cast (hT p (hUT hp)).ne_zero) exact Set.mem_iUnion.mpr ⟨⟨∏ p ∈ U, p, hdiv⟩, by simpa only [hlog] using hUy⟩ theorem primeSubsetSumSupport_inter_measure_le_divisorLogSupport {T : Finset ℕ} (hT : ∀ p ∈ T, p.Prime) (d : ℝ) (K : Set ℝ) : volume.real (primeSubsetSumSupport T d ∩ K) ≤ volume.real (divisorLogSupport (∏ p ∈ T, p) d ∩ K) := by apply measureReal_mono · exact Set.inter_subset_inter_left K (primeSubsetSumSupport_subset_divisorLogSupport hT d) · exact ne_top_of_le_ne_top (isCompact_divisorLogSupport _ _).measure_ne_top (measure_mono Set.inter_subset_left) end Erdos859Verification end /- Inlined development module: DyadicPrimeWindow.lean -/ section /- Consecutive dyadic bands form exactly one half-open prime log window. -/ open Finset Real namespace Erdos859Verification theorem primeLogWindow_union_adjacent {a b c : ℝ} (hab : a ≤ b) (hbc : b ≤ c) : primeLogWindow a b ∪ primeLogWindow b c = primeLogWindow a c := by ext p simp only [Finset.mem_union, mem_primeLogWindow] constructor · rintro (⟨hp, hpa, hpb⟩ | ⟨hp, hpb, hpc⟩) · exact ⟨hp, hpa, hpb.trans hbc⟩ · exact ⟨hp, hab.trans_lt hpb, hpc⟩ · rintro ⟨hp, hpa, hpc⟩ rcases le_or_gt (log (p : ℝ)) b with hpb | hpb · exact Or.inl ⟨hp, hpa, hpb⟩ · exact Or.inr ⟨hp, hpb, hpc⟩ theorem dyadicPrimeUniverse_eq_primeLogWindow {A : ℝ} (hA : 0 ≤ A) (k : ℕ) : dyadicPrimeUniverse A k = primeLogWindow A (A * (2 : ℝ) ^ k) := by induction k with | zero => ext p simp only [dyadicPrimeUniverse, Finset.range_zero, Finset.biUnion_empty, Finset.notMem_empty, mem_primeLogWindow, pow_zero, mul_one] constructor · intro hp exact hp.elim · rintro ⟨_, hlt, hle⟩ exact (not_lt_of_ge hle) hlt | succ k ih => have hab : A ≤ A * (2 : ℝ) ^ k := by simpa only [mul_one] using mul_le_mul_of_nonneg_left (one_le_pow₀ (by norm_num : (1 : ℝ) ≤ 2)) hA have hbc : A * (2 : ℝ) ^ k ≤ A * (2 : ℝ) ^ (k + 1) := mul_le_mul_of_nonneg_left (pow_le_pow_right₀ (by norm_num) (Nat.le_succ k)) hA calc dyadicPrimeUniverse A (k + 1) = dyadicPrimeUniverse A k ∪ dyadicPrimeBand A k := by simp only [dyadicPrimeUniverse, Finset.range_add_one, Finset.biUnion_insert, Finset.union_comm] _ = primeLogWindow A (A * (2 : ℝ) ^ k) ∪ primeLogWindow (A * (2 : ℝ) ^ k) (A * (2 : ℝ) ^ (k + 1)) := by rw [ih, dyadicPrimeBand] congr 2 rw [pow_succ] ring _ = _ := primeLogWindow_union_adjacent hab hbc theorem dyadicPrimeUniverse_subset_primeLogWindow {A X : ℝ} {k : ℕ} (hA : 0 ≤ A) (hX : A * (2 : ℝ) ^ k ≤ X) : dyadicPrimeUniverse A k ⊆ primeLogWindow A X := by rw [dyadicPrimeUniverse_eq_primeLogWindow hA] intro p hp obtain ⟨hpprime, hpa, hpx⟩ := mem_primeLogWindow.mp hp exact mem_primeLogWindow.mpr ⟨hpprime, hpa, hpx.trans hX⟩ end Erdos859Verification end /- Inlined development module: PrimeWindowPositiveSupport.lean -/ section /- Uniform positive support for arbitrary finite prime log windows. -/ open Finset Real MeasureTheory namespace Erdos859Verification /-- Select the largest dyadic scale below the requested upper endpoint. -/ theorem exists_dyadic_scale_below {A X : ℝ} (hA : 0 < A) (hX : 2 * A ≤ X) : ∃ k : ℕ, 1 ≤ k ∧ X / 2 < A * (2 : ℝ) ^ k ∧ A * (2 : ℝ) ^ k ≤ X := by have hratio : 1 ≤ X / A := (le_div_iff₀ hA).mpr (by nlinarith) obtain ⟨k, hklo, hkhi⟩ := exists_nat_pow_near hratio (by norm_num : (1 : ℝ) < 2) have hupper : A * (2 : ℝ) ^ k ≤ X := by simpa only [mul_comm] using (le_div_iff₀ hA).mp hklo have hlower : X / 2 < A * (2 : ℝ) ^ k := by have h := (div_lt_iff₀ hA).mp hkhi rw [pow_succ] at h nlinarith have hk : 1 ≤ k := by by_contra hk have hk0 : k = 0 := by omega simp only [hk0, pow_zero, mul_one] at hlower linarith exact ⟨k, hk, hlower, hupper⟩ /-- Enlarging a finite prime universe increases the probability of every increasing event. This is a consequence of exact marginal consistency. -/ theorem prime_tilt_increasing_event_mass_mono {P Q : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hQP : Q ⊆ P) {lam : ℝ} (hlam : 0 < lam) (F : Finset ℕ → Prop) [DecidablePred F] (hF : ∀ S T : Finset ℕ, S ⊆ T → F S → F T) : (∑ T ∈ Q.powerset.filter F, primeTiltWeight Q lam T) ≤ ∑ T ∈ P.powerset.filter F, primeTiltWeight P lam T := by classical rw [← prime_tilt_event_restrict hP hQP hlam F] apply Finset.sum_le_sum_of_subset_of_nonneg · intro T hT obtain ⟨hTP, hTF⟩ := Finset.mem_filter.mp hT exact Finset.mem_filter.mpr ⟨hTP, hF _ _ Finset.inter_subset_left hTF⟩ · intro T _ _ exact (primeTiltWeight_pos hP hlam T).le /-- The positive-support estimate holds uniformly for every upper endpoint and for any larger ambient finite prime universe. -/ theorem exists_primeWindow_positive_support_ambient {lam b B : ℝ} (hcritical : 1 < lam * log 2) (hb : 0 < b) (hB : 0 < B) : ∃ c : ℝ, 0 < c ∧ ∃ C : ℝ, 0 < C ∧ ∃ A0 : ℝ, 0 < A0 ∧ ∀ A : ℝ, A0 ≤ A → ∀ X : ℝ, 2 * A ≤ X → ∀ d : ℝ, b * A ≤ d → d ≤ B * A → ∀ P : Finset ℕ, (∀ p ∈ P, p.Prime) → primeLogWindow A X ⊆ P → (1 : ℝ) / 2 ≤ ∑ T ∈ P.powerset.filter (fun T ↦ c * X ≤ volume.real (primeSubsetSumSupport T d ∩ Set.Icc 0 (C * X))), primeTiltWeight P lam T := by classical obtain ⟨c, hc, C, hC, A0, hA0, hsupp⟩ := exists_dyadicPrime_positive_support hcritical hb hB refine ⟨c / 2, half_pos hc, C, hC, A0, hA0, ?_⟩ intro A hA X hX d hdlo hdhi P hP hwindow have hApos : 0 < A := hA0.trans_le hA have hlam : 0 < lam := by have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) nlinarith obtain ⟨k, hk, hklo, hkhi⟩ := exists_dyadic_scale_below hApos hX let Q := dyadicPrimeUniverse A k have hQP : Q ⊆ P := (dyadicPrimeUniverse_subset_primeLogWindow hApos.le hkhi).trans hwindow let Good : Finset ℕ → Prop := fun T ↦ c * (A * (2 : ℝ) ^ k) ≤ volume.real (primeSubsetSumSupport T d ∩ Set.Icc 0 (C * (A * (2 : ℝ) ^ k))) have hdyad : (1 : ℝ) / 2 ≤ ∑ T ∈ Q.powerset.filter Good, primeTiltWeight Q lam T := hsupp A hA k hk d hdlo hdhi have hrestricted : (1 : ℝ) / 2 ≤ ∑ T ∈ P.powerset.filter (fun T ↦ Good (T ∩ Q)), primeTiltWeight P lam T := by rw [prime_tilt_event_restrict hP hQP hlam Good] exact hdyad apply hrestricted.trans apply Finset.sum_le_sum_of_subset_of_nonneg · intro T hT obtain ⟨hTP, hTG⟩ := Finset.mem_filter.mp hT apply Finset.mem_filter.mpr refine ⟨hTP, ?_⟩ have hthreshold : c / 2 * X ≤ c * (A * (2 : ℝ) ^ k) := by have h := mul_le_mul_of_nonneg_left hklo.le hc.le nlinarith have hmeasure : volume.real (primeSubsetSumSupport (T ∩ Q) d ∩ Set.Icc 0 (C * (A * (2 : ℝ) ^ k))) ≤ volume.real (primeSubsetSumSupport T d ∩ Set.Icc 0 (C * X)) := by apply measureReal_mono · exact Set.inter_subset_inter (primeSubsetSumSupport_mono Finset.inter_subset_left d) (Set.Icc_subset_Icc le_rfl (mul_le_mul_of_nonneg_left hkhi hC.le)) · exact measure_ne_top_of_subset Set.inter_subset_left (isCompact_primeSubsetSumSupport T d).measure_ne_top exact hthreshold.trans (hTG.trans hmeasure) · intro T _ _ exact (primeTiltWeight_pos hP hlam T).le /-- Arbitrary prime-window version of the finite positive-support theorem. -/ theorem exists_primeWindow_positive_support {lam b B : ℝ} (hcritical : 1 < lam * log 2) (hb : 0 < b) (hB : 0 < B) : ∃ c : ℝ, 0 < c ∧ ∃ C : ℝ, 0 < C ∧ ∃ A0 : ℝ, 0 < A0 ∧ ∀ A : ℝ, A0 ≤ A → ∀ X : ℝ, 2 * A ≤ X → ∀ d : ℝ, b * A ≤ d → d ≤ B * A → (1 : ℝ) / 2 ≤ ∑ T ∈ (primeLogWindow A X).powerset.filter (fun T ↦ c * X ≤ volume.real (primeSubsetSumSupport T d ∩ Set.Icc 0 (C * X))), primeTiltWeight (primeLogWindow A X) lam T := by obtain ⟨c, hc, C, hC, A0, hA0, hsupport⟩ := exists_primeWindow_positive_support_ambient hcritical hb hB refine ⟨c, hc, C, hC, A0, hA0, ?_⟩ intro A hA X hX d hdlo hdhi exact hsupport A hA X hX d hdlo hdhi (primeLogWindow A X) (fun _ hp ↦ (mem_primeLogWindow.mp hp).1) (Subset.refl _) end Erdos859Verification end /- Inlined development module: ProperSignedCube.lean -/ section /- Proper bounded signed cubes and the arithmetic obstruction to adjoining a prime. -/ open Finset namespace Erdos859Verification def signedCubeValue {ι : Type*} [Fintype ι] (w : ι → ℕ) (c : ι → ℤ) : ℤ := ∑ i, c i * (w i : ℤ) def IsProperSignedCube {ι : Type*} [Fintype ι] (w : ι → ℕ) (H : ℕ) : Prop := ∀ c c' : ι → ℤ, (∀ i, |c i| ≤ (H : ℤ)) → (∀ i, |c' i| ≤ (H : ℤ)) → signedCubeValue w c = signedCubeValue w c' → c = c' noncomputable def signedCoefficientBox (ι : Type*) [Fintype ι] (H : ℕ) : Finset (ι → ℤ) := by classical exact Fintype.piFinset (fun _ : ι ↦ Icc (-(H : ℤ)) (H : ℤ)) theorem mem_signedCoefficientBox {ι : Type*} [Fintype ι] {H : ℕ} {c : ι → ℤ} : c ∈ signedCoefficientBox ι H ↔ ∀ i, |c i| ≤ (H : ℤ) := by classical simp only [signedCoefficientBox, Fintype.mem_piFinset, mem_Icc, abs_le] theorem card_signedCoefficientBox (ι : Type*) [Fintype ι] (H : ℕ) : (signedCoefficientBox ι H).card = (2 * H + 1) ^ Fintype.card ι := by classical have hcard : (Icc (-(H : ℤ)) (H : ℤ)).card = 2 * H + 1 := by rw [Int.card_Icc] omega simp [signedCoefficientBox, Fintype.card_piFinset, hcard] theorem signedCubeValue_sub {ι : Type*} [Fintype ι] (w : ι → ℕ) (c c' : ι → ℤ) : signedCubeValue w (fun i ↦ c i - c' i) = signedCubeValue w c - signedCubeValue w c' := by simp only [signedCubeValue, sub_mul, sum_sub_distrib] theorem abs_signedCubeValue_le {ι : Type*} [Fintype ι] (w : ι → ℕ) (c : ι → ℤ) {H : ℕ} (hc : ∀ i, |c i| ≤ (H : ℤ)) : |signedCubeValue w c| ≤ (H : ℤ) * ((∑ i, w i : ℕ) : ℤ) := by calc _ ≤ ∑ i, |c i * (w i : ℤ)| := Finset.abs_sum_le_sum_abs _ _ _ ≤ ∑ i, (H : ℤ) * (w i : ℤ) := by apply sum_le_sum intro i _ rw [abs_mul, abs_of_nonneg (Int.natCast_nonneg _)] exact mul_le_mul_of_nonneg_right (hc i) (Int.natCast_nonneg _) _ = _ := by rw [← mul_sum, Nat.cast_sum] noncomputable def positiveSignedCubeDifferences {ι : Type*} [Fintype ι] (w : ι → ℕ) (H : ℕ) : Finset ℕ := ((signedCoefficientBox ι (2 * H)).image (fun c ↦ (signedCubeValue w c).natAbs)).erase 0 theorem positiveSignedCubeDifferences_card_le {ι : Type*} [Fintype ι] (w : ι → ℕ) (H : ℕ) : (positiveSignedCubeDifferences w H).card ≤ (4 * H + 1) ^ Fintype.card ι := by classical calc _ ≤ ((signedCoefficientBox ι (2 * H)).image (fun c ↦ (signedCubeValue w c).natAbs)).card := card_erase_le _ ≤ (signedCoefficientBox ι (2 * H)).card := card_image_le _ = _ := by rw [card_signedCoefficientBox]; congr 1; omega theorem positiveSignedCubeDifferences_bounds {ι : Type*} [Fintype ι] (w : ι → ℕ) (H : ℕ) {m : ℕ} (hm : m ∈ positiveSignedCubeDifferences w H) : 0 < m ∧ m ≤ 2 * H * ∑ i, w i := by obtain ⟨hm0, hm⟩ := mem_erase.mp hm obtain ⟨c, hc, rfl⟩ := mem_image.mp hm refine ⟨Nat.pos_of_ne_zero hm0, ?_⟩ have hbound := abs_signedCubeValue_le w c (mem_signedCoefficientBox.mp hc) rw [← Int.natCast_natAbs] at hbound exact_mod_cast hbound theorem signedCube_difference_mem {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} {c c' : ι → ℤ} (hc : ∀ i, |c i| ≤ (H : ℤ)) (hc' : ∀ i, |c' i| ≤ (H : ℤ)) (hne : signedCubeValue w c - signedCubeValue w c' ≠ 0) : (signedCubeValue w c - signedCubeValue w c').natAbs ∈ positiveSignedCubeDifferences w H := by classical apply mem_erase.mpr refine ⟨Int.natAbs_ne_zero.mpr hne, ?_⟩ refine mem_image.mpr ⟨fun i ↦ c i - c' i, mem_signedCoefficientBox.mpr ?_, ?_⟩ · intro i calc |c i - c' i| ≤ |c i| + |c' i| := abs_sub _ _ _ ≤ (H : ℤ) + H := add_le_add (hc i) (hc' i) _ = _ := by push_cast; ring · rw [signedCubeValue_sub] def doubledCubeWeight {ι : Type*} (w : ι → ℕ) (p : ℕ) : ι ⊕ ι → ℕ := Sum.elim w (fun i ↦ p * w i) theorem signedCubeValue_doubled {ι : Type*} [Fintype ι] (w : ι → ℕ) (p : ℕ) (c : ι ⊕ ι → ℤ) : signedCubeValue (doubledCubeWeight w p) c = signedCubeValue w (fun i ↦ c (.inl i)) + (p : ℤ) * signedCubeValue w (fun i ↦ c (.inr i)) := by simp only [signedCubeValue, Fintype.sum_sum_type, doubledCubeWeight, Sum.elim_inl, Sum.elim_inr, Nat.cast_mul, mul_sum] congr 1 apply sum_congr rfl intro i _ ring /-- A nonzero prime extension can fail only by dividing a nonzero old coefficient difference. No primality is needed for this algebraic fact. -/ theorem notproper_doubledCube_dvd_difference {ι : Type*} [Fintype ι] (w : ι → ℕ) {H p : ℕ} (hproper : IsProperSignedCube w H) (hp : p ≠ 0) (hbad : ¬ IsProperSignedCube (doubledCubeWeight w p) H) : ∃ m ∈ positiveSignedCubeDifferences w H, p ∣ m := by classical by_contra hn apply hbad intro c c' hc hc' heq let u := signedCubeValue w (fun i ↦ c (.inl i)) - signedCubeValue w (fun i ↦ c' (.inl i)) let v := signedCubeValue w (fun i ↦ c (.inr i)) - signedCubeValue w (fun i ↦ c' (.inr i)) have hrelation : u + (p : ℤ) * v = 0 := by rw [signedCubeValue_doubled, signedCubeValue_doubled] at heq dsimp [u, v] linear_combination heq have hu : u = 0 := by by_contra hne have hm : u.natAbs ∈ positiveSignedCubeDifferences w H := signedCube_difference_mem w (fun i ↦ hc (.inl i)) (fun i ↦ hc' (.inl i)) hne have hdiv : (p : ℤ) ∣ u := ⟨-v, by linear_combination hrelation⟩ exact hn ⟨u.natAbs, hm, Int.natCast_dvd.mp hdiv⟩ have hpz : (p : ℤ) ≠ 0 := by exact_mod_cast hp have hv : v = 0 := by rw [hu, zero_add] at hrelation exact (mul_eq_zero.mp hrelation).resolve_left hpz have hleft : (fun i ↦ c (.inl i)) = (fun i ↦ c' (.inl i)) := hproper _ _ (fun i ↦ hc (.inl i)) (fun i ↦ hc' (.inl i)) (sub_eq_zero.mp hu) have hright : (fun i ↦ c (.inr i)) = (fun i ↦ c' (.inr i)) := hproper _ _ (fun i ↦ hc (.inr i)) (fun i ↦ hc' (.inr i)) (sub_eq_zero.mp hv) funext j cases j with | inl i => exact congrFun hleft i | inr i => exact congrFun hright i theorem isProperSignedCube_one (H : ℕ) : IsProperSignedCube (fun _ : Unit ↦ 1) H := by intro c c' _hc _hc' heq funext i cases i simpa only [signedCubeValue, Fintype.sum_unique, Nat.cast_one, mul_one] using heq end Erdos859Verification end /- Inlined development module: ProperCubePrimeExtension.lean -/ section /- Finite prime-mark failure bounds for arithmetic cube extensions. -/ namespace Erdos859Verification open Finset Real /-- An arithmetic extension can fail only when its prime divides an old nonzero difference. A bound for each mark atom gives a uniform failure bound. -/ theorem finite_prime_extension_failure_weight_le (P D : Finset ℕ) (w : ℕ → ℝ) (Bad : ℕ → Prop) [DecidablePred Bad] {v alpha : ℝ} {T : ℕ} (hv : 0 < v) (halpha : 0 ≤ alpha) (hP : ∀ p ∈ P, p.Prime) (hlog : ∀ p ∈ P, v ≤ log (p : ℝ)) (hw : ∀ p ∈ P, 0 ≤ w p) (hatom : ∀ p ∈ P, w p ≤ alpha) (hD : ∀ m ∈ D, 0 < m ∧ m ≤ T) (hbad : ∀ p ∈ P, Bad p → ∃ m ∈ D, p ∣ m) : (∑ p ∈ P.filter Bad, w p) ≤ (alpha / v) * (D.card : ℝ) * log (T : ℝ) := by classical calc _ ≤ ∑ p ∈ P.filter (fun p ↦ ∃ m ∈ D, p ∣ m), w p := by apply sum_le_sum_of_subset_of_nonneg · intro p hp exact mem_filter.mpr ⟨(mem_filter.mp hp).1, hbad p (mem_filter.mp hp).1 (mem_filter.mp hp).2⟩ · intro p hp _ exact hw p (mem_filter.mp hp).1 _ ≤ ∑ m ∈ D, ∑ p ∈ P.filter (fun p ↦ p ∣ m), w p := finite_nat_weighted_union_bound P D w hw (fun m p ↦ p ∣ m) _ ≤ ∑ m ∈ D, alpha * (log (m : ℝ) / v) := by apply sum_le_sum intro m hm calc _ ≤ ∑ _p ∈ P.filter (fun p ↦ p ∣ m), alpha := sum_le_sum (fun p hp ↦ hatom p (mem_filter.mp hp).1) _ = alpha * ((P.filter (fun p ↦ p ∣ m)).card : ℝ) := by simp [mul_comm] _ ≤ _ := mul_le_mul_of_nonneg_left (card_large_prime_divisors_le (hD m hm).1 hv hP hlog) halpha _ ≤ ∑ _m ∈ D, alpha * (log (T : ℝ) / v) := by apply sum_le_sum intro m hm apply mul_le_mul_of_nonneg_left _ halpha exact div_le_div_of_nonneg_right (log_le_log (by exact_mod_cast (hD m hm).1) (by exact_mod_cast (hD m hm).2)) hv.le _ = _ := by simp; ring theorem finite_prime_extension_success_weight_ge (P D : Finset ℕ) (w : ℕ → ℝ) (Bad : ℕ → Prop) [DecidablePred Bad] {v alpha : ℝ} {T : ℕ} (hv : 0 < v) (halpha : 0 ≤ alpha) (hP : ∀ p ∈ P, p.Prime) (hlog : ∀ p ∈ P, v ≤ log (p : ℝ)) (hw : ∀ p ∈ P, 0 ≤ w p) (hatom : ∀ p ∈ P, w p ≤ alpha) (hnorm : ∑ p ∈ P, w p = 1) (hD : ∀ m ∈ D, 0 < m ∧ m ≤ T) (hbad : ∀ p ∈ P, Bad p → ∃ m ∈ D, p ∣ m) : 1 - (alpha / v) * (D.card : ℝ) * log (T : ℝ) ≤ ∑ p ∈ P.filter (fun p ↦ ¬ Bad p), w p := by have hf := finite_prime_extension_failure_weight_le P D w Bad hv halpha hP hlog hw hatom hD hbad have hs := sum_filter_add_sum_filter_not P Bad w rw [hnorm] at hs linarith theorem primeLogMark_broad_extension_failure_le (D : Finset ℕ) (Bad : ℕ → Prop) [DecidablePred Bad] {v eps : ℝ} {T : ℕ} (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) (hD : ∀ m ∈ D, 0 < m ∧ m ≤ T) (hbad : ∀ p ∈ primeLogWindow v ((1 + eps) * v), Bad p → ∃ m ∈ D, p ∣ m) : (∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter Bad, primeLogMarkWeight v ((1 + eps) * v) p) ≤ (4 * exp (-v) / eps / v) * (D.card : ℝ) * log (T : ℝ) := by have hm := primeLogWindowMass_broad_lower hv heps heps1 hlarge have hm0 : 0 < primeLogWindowMass v ((1 + eps) * v) := (by positivity : 0 < eps / 4).trans_le hm exact finite_prime_extension_failure_weight_le _ D _ Bad ((log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv) (by positivity) (fun _ hp ↦ (mem_primeLogWindow.mp hp).1) (fun _ hp ↦ (mem_primeLogWindow.mp hp).2.1.le) (fun _ _ ↦ by unfold primeLogMarkWeight; positivity) (fun _ hp ↦ primeLogMark_broad_atom_upper hv heps heps1 hlarge hp) hD hbad /-- Intensity whose Poisson occupancy gives the exact tilted prime indicator. -/ noncomputable def primeLogOddsIntensity (lam : ℝ) (p : ℕ) : ℝ := log (1 + lam / ((p : ℝ) - 1)) theorem primeLogOddsIntensity_bounds {lam : ℝ} {p : ℕ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hp : p.Prime) : 1 / (p : ℝ) ≤ primeLogOddsIntensity lam p ∧ primeLogOddsIntensity lam p ≤ 4 / (p : ℝ) := by have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le have hp0 : (0 : ℝ) < p := by linarith have hden : 0 < (p : ℝ) - 1 := by linarith have hx : 0 < 1 + lam / ((p : ℝ) - 1) := by positivity have hlow := one_sub_inv_le_log_of_pos hx have hhigh := log_le_sub_one_of_pos hx unfold primeLogOddsIntensity constructor · apply le_trans _ hlow have hden' : 0 < (p : ℝ) - 1 + lam := by linarith have hid : 1 - (1 + lam / ((p : ℝ) - 1))⁻¹ = lam / ((p : ℝ) - 1 + lam) := by field_simp; ring rw [hid] apply (div_le_div_iff₀ hp0 hden').mpr nlinarith [mul_nonneg (sub_nonneg.mpr hlam) (sub_nonneg.mpr hp2)] · apply hhigh.trans have hu : lam / ((p : ℝ) - 1) ≤ 4 / (p : ℝ) := by apply (div_le_div_iff₀ hden hp0).mpr nlinarith linarith noncomputable def primeLogOddsMarkWeight (lam v u : ℝ) (p : ℕ) : ℝ := primeLogOddsIntensity lam p / ∑ q ∈ primeLogWindow v u, primeLogOddsIntensity lam q theorem primeLogOddsIntensity_broad_mass_lower {lam v eps : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) : eps / 4 ≤ ∑ p ∈ primeLogWindow v ((1 + eps) * v), primeLogOddsIntensity lam p := by apply (primeLogWindowMass_broad_lower hv heps heps1 hlarge).trans apply sum_le_sum intro p hp exact (primeLogOddsIntensity_bounds hlam hlam2 (mem_primeLogWindow.mp hp).1).1 theorem primeLogOddsMark_broad_normalized {lam v eps : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) : (∀ p ∈ primeLogWindow v ((1 + eps) * v), 0 ≤ primeLogOddsMarkWeight lam v ((1 + eps) * v) p) ∧ (∑ p ∈ primeLogWindow v ((1 + eps) * v), primeLogOddsMarkWeight lam v ((1 + eps) * v) p) = 1 := by have hm := primeLogOddsIntensity_broad_mass_lower hlam hlam2 hv heps heps1 hlarge have hm0 : 0 < ∑ p ∈ primeLogWindow v ((1 + eps) * v), primeLogOddsIntensity lam p := (by positivity : 0 < eps / 4).trans_le hm constructor · intro p hp exact div_nonneg ((by positivity : 0 ≤ 1 / (p : ℝ)).trans (primeLogOddsIntensity_bounds hlam hlam2 (mem_primeLogWindow.mp hp).1).1) hm0.le · simp only [primeLogOddsMarkWeight, ← sum_div] exact div_self hm0.ne' theorem primeLogOddsMark_broad_atom_upper {lam v eps : ℝ} {p : ℕ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) (hp : p ∈ primeLogWindow v ((1 + eps) * v)) : primeLogOddsMarkWeight lam v ((1 + eps) * v) p ≤ 16 * exp (-v) / eps := by have hm := primeLogOddsIntensity_broad_mass_lower hlam hlam2 hv heps heps1 hlarge have hm0 : 0 < ∑ p ∈ primeLogWindow v ((1 + eps) * v), primeLogOddsIntensity lam p := (by positivity : 0 < eps / 4).trans_le hm have hp' := mem_primeLogWindow.mp hp have hp0 : (0 : ℝ) < p := by exact_mod_cast hp'.1.pos have hrecip : 1 / (p : ℝ) ≤ exp (-v) := by rw [exp_neg, ← one_div] exact one_div_le_one_div_of_le (exp_pos v) (((lt_log_iff_exp_lt hp0).mp hp'.2.1).le) unfold primeLogOddsMarkWeight calc _ ≤ (4 / (p : ℝ)) / (∑ q ∈ primeLogWindow v ((1 + eps) * v), primeLogOddsIntensity lam q) := div_le_div_of_nonneg_right (primeLogOddsIntensity_bounds hlam hlam2 hp'.1).2 hm0.le _ ≤ (4 / (p : ℝ)) / (eps / 4) := div_le_div_of_nonneg_left (by positivity) (by positivity) hm _ ≤ (4 * exp (-v)) / (eps / 4) := div_le_div_of_nonneg_right (by simpa only [mul_one_div] using mul_le_mul_of_nonneg_left hrecip (by norm_num : (0 : ℝ) ≤ 4)) (by positivity) _ = _ := by ring theorem primeLogOddsMark_broad_extension_failure_le (D : Finset ℕ) (Bad : ℕ → Prop) [DecidablePred Bad] {lam v eps : ℝ} {T : ℕ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) (hD : ∀ m ∈ D, 0 < m ∧ m ≤ T) (hbad : ∀ p ∈ primeLogWindow v ((1 + eps) * v), Bad p → ∃ m ∈ D, p ∣ m) : (∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter Bad, primeLogOddsMarkWeight lam v ((1 + eps) * v) p) ≤ (16 * exp (-v) / eps / v) * (D.card : ℝ) * log (T : ℝ) := by exact finite_prime_extension_failure_weight_le _ D _ Bad ((log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv) (by positivity) (fun _ hp ↦ (mem_primeLogWindow.mp hp).1) (fun _ hp ↦ (mem_primeLogWindow.mp hp).2.1.le) (primeLogOddsMark_broad_normalized hlam hlam2 hv heps heps1 hlarge).1 (fun _ hp ↦ primeLogOddsMark_broad_atom_upper hlam hlam2 hv heps heps1 hlarge hp) hD hbad /-- A difference-count exponential is cancelled by the lower prime scale. This isolates the arithmetic estimate used at every extension stage. -/ theorem prime_extension_divisor_bound_le_exp (D : Finset ℕ) {T : ℕ} {v eps coeff K W s : ℝ} (hv : 0 < v) (heps : 0 < eps) (hcoeff : 0 ≤ coeff) (hcard : (D.card : ℝ) ≤ exp W) (hsize : log (T : ℝ) ≤ K * v) (hgap : W - v ≤ -s) : (coeff * exp (-v) / eps / v) * (D.card : ℝ) * log (T : ℝ) ≤ (coeff * K / eps) * exp (-s) := by have hlog0 := log_natCast_nonneg T have hratio : log (T : ℝ) / v ≤ K := (div_le_iff₀ hv).mpr hsize have hcount : (D.card : ℝ) * exp (-v) ≤ exp (-s) := by calc _ ≤ exp W * exp (-v) := mul_le_mul_of_nonneg_right hcard (exp_pos _).le _ = exp (W - v) := by rw [← exp_add]; rfl _ ≤ _ := exp_le_exp.mpr hgap calc _ = (coeff / eps) * ((D.card : ℝ) * exp (-v)) * (log (T : ℝ) / v) := by ring _ ≤ (coeff / eps) * exp (-s) * K := mul_le_mul (mul_le_mul_of_nonneg_left hcount (div_nonneg hcoeff heps.le)) hratio (div_nonneg hlog0 hv.le) (by positivity) _ = _ := by ring theorem primeLogOddsMark_broad_extension_failure_exp_le (D : Finset ℕ) (Bad : ℕ → Prop) [DecidablePred Bad] {lam v eps K W s : ℝ} {T : ℕ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) (hD : ∀ m ∈ D, 0 < m ∧ m ≤ T) (hbad : ∀ p ∈ primeLogWindow v ((1 + eps) * v), Bad p → ∃ m ∈ D, p ∣ m) (hcard : (D.card : ℝ) ≤ exp W) (hsize : log (T : ℝ) ≤ K * v) (hgap : W - v ≤ -s) : (∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter Bad, primeLogOddsMarkWeight lam v ((1 + eps) * v) p) ≤ (16 * K / eps) * exp (-s) := by exact (primeLogOddsMark_broad_extension_failure_le D Bad hlam hlam2 hv heps heps1 hlarge hD hbad).trans (prime_extension_divisor_bound_le_exp D ((log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv) heps (by norm_num) hcard hsize hgap) noncomputable def improperCubeExtensionPrimes {ι : Type*} [Fintype ι] (w : ι → ℕ) (H : ℕ) (P : Finset ℕ) : Finset ℕ := by classical exact P.filter (fun p ↦ ¬ IsProperSignedCube (doubledCubeWeight w p) H) noncomputable def properCubeExtensionPrimes {ι : Type*} [Fintype ι] (w : ι → ℕ) (H : ℕ) (P : Finset ℕ) : Finset ℕ := by classical exact P.filter (fun p ↦ IsProperSignedCube (doubledCubeWeight w p) H) /-- The failure bound for an arbitrary finite normalized prime-mark model. No independence or conditioning hypothesis is hidden in this one-step statement. -/ theorem improperCubeExtension_weight_le {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) (P : Finset ℕ) (mu : ℕ → ℝ) {v alpha : ℝ} (hv : 0 < v) (halpha : 0 ≤ alpha) (hP : ∀ p ∈ P, p.Prime) (hlog : ∀ p ∈ P, v ≤ log (p : ℝ)) (hmu : ∀ p ∈ P, 0 ≤ mu p) (hatom : ∀ p ∈ P, mu p ≤ alpha) : (∑ p ∈ improperCubeExtensionPrimes w H P, mu p) ≤ (alpha / v) * (((4 * H + 1) ^ Fintype.card ι : ℕ) : ℝ) * log ((2 * H * ∑ i, w i : ℕ) : ℝ) := by classical have hfailure := finite_prime_extension_failure_weight_le P (positiveSignedCubeDifferences w H) mu (fun p ↦ ¬ IsProperSignedCube (doubledCubeWeight w p) H) hv halpha hP hlog hmu hatom (fun _ hm ↦ positiveSignedCubeDifferences_bounds w H hm) (fun p hp hb ↦ notproper_doubledCube_dvd_difference w hproper (hP p hp).ne_zero hb) apply hfailure.trans apply mul_le_mul_of_nonneg_right _ (log_natCast_nonneg _) apply mul_le_mul_of_nonneg_left _ (div_nonneg halpha hv.le) exact_mod_cast positiveSignedCubeDifferences_card_le w H theorem properCubeExtension_weight_ge {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) (P : Finset ℕ) (mu : ℕ → ℝ) {v alpha : ℝ} (hv : 0 < v) (halpha : 0 ≤ alpha) (hP : ∀ p ∈ P, p.Prime) (hlog : ∀ p ∈ P, v ≤ log (p : ℝ)) (hmu : ∀ p ∈ P, 0 ≤ mu p) (hatom : ∀ p ∈ P, mu p ≤ alpha) (hnorm : ∑ p ∈ P, mu p = 1) : 1 - (alpha / v) * (((4 * H + 1) ^ Fintype.card ι : ℕ) : ℝ) * log ((2 * H * ∑ i, w i : ℕ) : ℝ) ≤ ∑ p ∈ properCubeExtensionPrimes w H P, mu p := by classical have hf := improperCubeExtension_weight_le w hproper P mu hv halpha hP hlog hmu hatom have hs := sum_filter_add_sum_filter_not P (fun p ↦ IsProperSignedCube (doubledCubeWeight w p) H) mu rw [hnorm] at hs change (∑ p ∈ properCubeExtensionPrimes w H P, mu p) + (∑ p ∈ improperCubeExtensionPrimes w H P, mu p) = 1 at hs linarith theorem improperCubeExtension_logOdds_broad_weight_le {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) {lam v eps : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) : (∑ p ∈ improperCubeExtensionPrimes w H (primeLogWindow v ((1 + eps) * v)), primeLogOddsMarkWeight lam v ((1 + eps) * v) p) ≤ (16 * exp (-v) / eps / v) * (((4 * H + 1) ^ Fintype.card ι : ℕ) : ℝ) * log ((2 * H * ∑ i, w i : ℕ) : ℝ) := by exact improperCubeExtension_weight_le w hproper _ _ ((log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv) (by positivity) (fun _ hp ↦ (mem_primeLogWindow.mp hp).1) (fun _ hp ↦ (mem_primeLogWindow.mp hp).2.1.le) (primeLogOddsMark_broad_normalized hlam hlam2 hv heps heps1 hlarge).1 (fun _ hp ↦ primeLogOddsMark_broad_atom_upper hlam hlam2 hv heps heps1 hlarge hp) theorem improperCubeExtension_logOdds_broad_exp_le {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) {lam v eps K W s : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) (hcard : (((4 * H + 1) ^ Fintype.card ι : ℕ) : ℝ) ≤ exp W) (hsize : log ((2 * H * ∑ i, w i : ℕ) : ℝ) ≤ K * v) (hgap : W - v ≤ -s) : (∑ p ∈ improperCubeExtensionPrimes w H (primeLogWindow v ((1 + eps) * v)), primeLogOddsMarkWeight lam v ((1 + eps) * v) p) ≤ (16 * K / eps) * exp (-s) := by classical have hcount : ((positiveSignedCubeDifferences w H).card : ℝ) ≤ exp W := by apply le_trans _ hcard exact_mod_cast positiveSignedCubeDifferences_card_le w H exact primeLogOddsMark_broad_extension_failure_exp_le (positiveSignedCubeDifferences w H) (fun p ↦ ¬ IsProperSignedCube (doubledCubeWeight w p) H) hlam hlam2 hv heps heps1 hlarge (fun _ hm ↦ positiveSignedCubeDifferences_bounds w H hm) (fun p hp hb ↦ notproper_doubledCube_dvd_difference w hproper (mem_primeLogWindow.mp hp).1.ne_zero hb) hcount hsize hgap end Erdos859Verification end /- Inlined development module: DivisorCubeStructure.lean -/ section /- The signed cube generated by every divisor of a squarefree prime product. -/ namespace Erdos859Verification open Finset Real abbrev DivisorCubeCoordinate (P : Finset ℕ) := ↥P.powerset def divisorCubeWeight (P : Finset ℕ) (U : DivisorCubeCoordinate P) : ℕ := ∏ p ∈ (U : Finset ℕ), p theorem card_divisorCubeCoordinate (P : Finset ℕ) : Fintype.card (DivisorCubeCoordinate P) = 2 ^ P.card := by simp [DivisorCubeCoordinate] theorem divisorCubeWeight_dvd (P : Finset ℕ) (U : DivisorCubeCoordinate P) : divisorCubeWeight P U ∣ ∏ p ∈ P, p := prod_dvd_prod_of_subset U.val P id (mem_powerset.mp U.property) theorem sum_divisorCubeWeight (P : Finset ℕ) : (∑ U : DivisorCubeCoordinate P, divisorCubeWeight P U) = ∏ p ∈ P, (1 + p) := by unfold divisorCubeWeight rw [sum_coe_sort P.powerset (fun U : Finset ℕ ↦ ∏ p ∈ U, p)] exact (prod_one_add P).symm theorem divisorCubeWeight_pos {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (U : DivisorCubeCoordinate P) : 0 < divisorCubeWeight P U := prod_pos (fun p hp ↦ (hP p (mem_powerset.mp U.property hp)).pos) theorem squarefree_divisorCubeProduct {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) : Squarefree (∏ p ∈ P, p) := by refine squarefree_prod_of_pairwise_isCoprime (fun p hp q hq hpq ↦ ?_) (fun p hp ↦ (hP p hp).squarefree) change IsRelPrime p q rw [← Nat.coprime_iff_isRelPrime] exact (Nat.coprime_primes (hP p hp) (hP q hq)).mpr hpq theorem divisorCubeWeight_injective {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) : Function.Injective (divisorCubeWeight P) := by intro U V hUV apply Subtype.ext have hU : (divisorCubeWeight P U).primeFactors = U.val := Nat.primeFactors_prod (fun p hp ↦ hP p (mem_powerset.mp U.property hp)) have hV : (divisorCubeWeight P V).primeFactors = V.val := Nat.primeFactors_prod (fun p hp ↦ hP p (mem_powerset.mp V.property hp)) rw [← hU, ← hV, hUV] /-- These coordinates enumerate all positive divisors, without multiplicity. -/ theorem image_divisorCubeWeight {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) : univ.image (divisorCubeWeight P) = (∏ p ∈ P, p).divisors := by have hprod := squarefree_divisorCubeProduct hP ext d constructor · intro hd obtain ⟨U, _, rfl⟩ := mem_image.mp hd exact Nat.mem_divisors.mpr ⟨divisorCubeWeight_dvd P U, hprod.ne_zero⟩ · intro hd have hdiv := (Nat.mem_divisors.mp hd).1 have hsub : d.primeFactors ⊆ P := by have h := Nat.primeFactors_mono hdiv hprod.ne_zero rwa [Nat.primeFactors_prod hP] at h refine mem_image.mpr ⟨⟨d.primeFactors, mem_powerset.mpr hsub⟩, mem_univ _, ?_⟩ exact Nat.prod_primeFactors_of_squarefree (hprod.squarefree_of_dvd hdiv) theorem sum_divisors_primeProduct {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) : (∑ d ∈ (∏ p ∈ P, p).divisors, d) = ∏ p ∈ P, (1 + p) := by rw [← image_divisorCubeWeight hP, sum_image] · exact sum_divisorCubeWeight P · exact fun _ _ _ _ h ↦ divisorCubeWeight_injective hP h theorem log_divisorCubeProduct {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) : log ((∏ p ∈ P, p : ℕ) : ℝ) = ∑ p ∈ P, log (p : ℝ) := by rw [Nat.cast_prod, Real.log_prod] intro p hp exact_mod_cast (hP p hp).ne_zero theorem sum_divisorCubeWeight_le_product_sq {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) : (∑ U : DivisorCubeCoordinate P, divisorCubeWeight P U) ≤ (∏ p ∈ P, p) ^ 2 := by rw [sum_divisorCubeWeight, ← prod_pow] apply prod_le_prod (fun _ _ ↦ Nat.zero_le _) intro p hp have h := (hP p hp).two_le nlinarith theorem sum_divisorCubeWeight_insert (P : Finset ℕ) (p : ℕ) (hp : p ∉ P) : (∑ U : DivisorCubeCoordinate (insert p P), divisorCubeWeight (insert p P) U) = (1 + p) * ∑ U : DivisorCubeCoordinate P, divisorCubeWeight P U := by rw [sum_divisorCubeWeight, sum_divisorCubeWeight, prod_insert hp] theorem isProper_divisorCube_empty (H : ℕ) : IsProperSignedCube (divisorCubeWeight ∅) H := by intro c c' _hc _hc' heq funext U have hU : U.val = ∅ := subset_empty.mp (mem_powerset.mp U.property) have hall (V : DivisorCubeCoordinate ∅) : V = U := by apply Subtype.ext exact (subset_empty.mp (mem_powerset.mp V.property)).trans hU.symm have hsum (a : DivisorCubeCoordinate ∅ → ℤ) : signedCubeValue (divisorCubeWeight ∅) a = a U := by unfold signedCubeValue rw [sum_eq_single U] · simp [divisorCubeWeight, hU] · intro V _ hne exact False.elim (hne (hall V)) · intro h exact False.elim (h (mem_univ U)) rwa [hsum, hsum] at heq def divisorCubeInsertMap (P : Finset ℕ) (p : ℕ) : DivisorCubeCoordinate P ⊕ DivisorCubeCoordinate P → DivisorCubeCoordinate (insert p P) | .inl U => ⟨U.val, mem_powerset.mpr ((mem_powerset.mp U.property).trans (subset_insert _ _))⟩ | .inr U => ⟨insert p U.val, mem_powerset.mpr (insert_subset_insert p (mem_powerset.mp U.property))⟩ theorem divisorCubeInsertMap_bijective (P : Finset ℕ) (p : ℕ) (hp : p ∉ P) : Function.Bijective (divisorCubeInsertMap P p) := by have hnot (U : DivisorCubeCoordinate P) : p ∉ U.val := fun h ↦ hp (mem_powerset.mp U.property h) constructor · intro X Y hXY have heq := congrArg Subtype.val hXY cases X with | inl U => cases Y with | inl V => exact congrArg Sum.inl (Subtype.ext heq) | inr V => change U.val = insert p V.val at heq exact False.elim (hnot U (heq.symm ▸ mem_insert_self p V.val)) | inr U => cases Y with | inl V => change insert p U.val = V.val at heq exact False.elim (hnot V (heq ▸ mem_insert_self p U.val)) | inr V => change insert p U.val = insert p V.val at heq have he := congrArg (fun S : Finset ℕ ↦ S.erase p) heq simp only [erase_insert (hnot U), erase_insert (hnot V)] at he exact congrArg Sum.inr (Subtype.ext he) · intro U by_cases hpu : p ∈ U.val · have hsub : U.val.erase p ⊆ P := by intro q hq have h := mem_powerset.mp U.property (mem_erase.mp hq).2 rcases mem_insert.mp h with h | h · exact False.elim ((mem_erase.mp hq).1 h) · exact h refine ⟨.inr ⟨U.val.erase p, mem_powerset.mpr hsub⟩, ?_⟩ apply Subtype.ext exact insert_erase hpu · have hsub : U.val ⊆ P := by intro q hq rcases mem_insert.mp (mem_powerset.mp U.property hq) with h | h · exact False.elim (hpu (h ▸ hq)) · exact h exact ⟨.inl ⟨U.val, mem_powerset.mpr hsub⟩, Subtype.ext rfl⟩ noncomputable def divisorCubeInsertEquiv (P : Finset ℕ) (p : ℕ) (hp : p ∉ P) : DivisorCubeCoordinate P ⊕ DivisorCubeCoordinate P ≃ DivisorCubeCoordinate (insert p P) := Equiv.ofBijective (divisorCubeInsertMap P p) (divisorCubeInsertMap_bijective P p hp) theorem divisorCubeWeight_insert_equiv (P : Finset ℕ) (p : ℕ) (hp : p ∉ P) (U : DivisorCubeCoordinate P ⊕ DivisorCubeCoordinate P) : divisorCubeWeight (insert p P) (divisorCubeInsertEquiv P p hp U) = doubledCubeWeight (divisorCubeWeight P) p U := by cases U with | inl U => rfl | inr U => exact prod_insert (fun h ↦ hp (mem_powerset.mp U.property h)) theorem signedCubeValue_comp_equiv {ι κ : Type*} [Fintype ι] [Fintype κ] (e : ι ≃ κ) (w : κ → ℕ) (c : κ → ℤ) : signedCubeValue (fun i ↦ w (e i)) (fun i ↦ c (e i)) = signedCubeValue w c := e.sum_comp (fun j ↦ c j * (w j : ℤ)) theorem isProperSignedCube_comp_equiv {ι κ : Type*} [Fintype ι] [Fintype κ] (e : ι ≃ κ) (w : κ → ℕ) (H : ℕ) : IsProperSignedCube (fun i ↦ w (e i)) H ↔ IsProperSignedCube w H := by constructor · intro h c c' hc hc' heq have hcoeff := h (fun i ↦ c (e i)) (fun i ↦ c' (e i)) (fun i ↦ hc (e i)) (fun i ↦ hc' (e i)) (by rw [signedCubeValue_comp_equiv, signedCubeValue_comp_equiv] exact heq) funext j simpa only [Equiv.apply_symm_apply] using congrFun hcoeff (e.symm j) · intro h c c' hc hc' heq have hsum (a : ι → ℤ) : signedCubeValue w (fun j ↦ a (e.symm j)) = signedCubeValue (fun i ↦ w (e i)) a := by symm simpa only [Equiv.symm_apply_apply] using signedCubeValue_comp_equiv e w (fun j ↦ a (e.symm j)) have hcoeff := h (fun j ↦ c (e.symm j)) (fun j ↦ c' (e.symm j)) (fun j ↦ hc (e.symm j)) (fun j ↦ hc' (e.symm j)) (by rw [hsum, hsum] exact heq) funext i simpa only [Equiv.symm_apply_apply] using congrFun hcoeff (e i) /-- Adjoining a fresh prime is exactly the doubled divisor cube. -/ theorem isProper_divisorCube_insert_iff (P : Finset ℕ) (p : ℕ) (hp : p ∉ P) (H : ℕ) : IsProperSignedCube (divisorCubeWeight (insert p P)) H ↔ IsProperSignedCube (doubledCubeWeight (divisorCubeWeight P) p) H := by have h := isProperSignedCube_comp_equiv (divisorCubeInsertEquiv P p hp) (divisorCubeWeight (insert p P)) H have hw : (fun U ↦ divisorCubeWeight (insert p P) (divisorCubeInsertEquiv P p hp U)) = doubledCubeWeight (divisorCubeWeight P) p := by funext U exact divisorCubeWeight_insert_equiv P p hp U rw [hw] at h exact h.symm theorem notproper_divisorCube_insert_dvd_difference (P : Finset ℕ) {H p : ℕ} (hproper : IsProperSignedCube (divisorCubeWeight P) H) (hp : p ∉ P) (hp0 : p ≠ 0) (hbad : ¬ IsProperSignedCube (divisorCubeWeight (insert p P)) H) : ∃ m ∈ positiveSignedCubeDifferences (divisorCubeWeight P) H, p ∣ m := by apply notproper_doubledCube_dvd_difference (divisorCubeWeight P) hproper hp0 exact fun h ↦ hbad ((isProper_divisorCube_insert_iff P p hp H).mpr h) theorem positive_divisorCube_difference_bounds (P : Finset ℕ) (H : ℕ) {m : ℕ} (hm : m ∈ positiveSignedCubeDifferences (divisorCubeWeight P) H) : 0 < m ∧ m ≤ 2 * H * ∏ p ∈ P, (1 + p) := by simpa only [sum_divisorCubeWeight] using positiveSignedCubeDifferences_bounds (divisorCubeWeight P) H hm theorem positive_divisorCube_differences_card_le (P : Finset ℕ) (H : ℕ) : (positiveSignedCubeDifferences (divisorCubeWeight P) H).card ≤ (4 * H + 1) ^ (2 ^ P.card) := by simpa only [card_divisorCubeCoordinate] using positiveSignedCubeDifferences_card_le (divisorCubeWeight P) H end Erdos859Verification end /- Inlined development module: FordDivisorIntervals.lean -/ section /- Finite covering bounds for thickened logarithmic subset sums. -/ open Finset Real MeasureTheory namespace Erdos859Verification /-- Fixing the selected elements outside `S` puts all remaining subset sums inside one interval of length `d + sum_{p in S} log p`. -/ theorem primeSubsetSumSupport_complement_cover (T S : Finset ℕ) (d : ℝ) : primeSubsetSumSupport T d ⊆ ⋃ U : (T \ S).powerset, Set.Icc (∑ p ∈ (U : Finset ℕ), log (p : ℝ)) ((∑ p ∈ (U : Finset ℕ), log (p : ℝ)) + (∑ p ∈ S, log (p : ℝ)) + d) := by intro y hy obtain ⟨V, hVT, hVy⟩ := mem_primeSubsetSumSupport.mp hy have hVS : V \ S ⊆ T \ S := by intro p hp exact mem_sdiff.mpr ⟨hVT (mem_sdiff.mp hp).1, (mem_sdiff.mp hp).2⟩ apply Set.mem_iUnion.mpr refine ⟨⟨V \ S, mem_powerset.mpr hVS⟩, ?_⟩ have hsplit := sum_inter_add_sum_sdiff V S (fun p ↦ log (p : ℝ)) have hnonneg : 0 ≤ ∑ p ∈ V ∩ S, log (p : ℝ) := sum_nonneg (fun p _ ↦ Real.log_natCast_nonneg p) have hsum : (∑ p ∈ V ∩ S, log (p : ℝ)) ≤ ∑ p ∈ S, log (p : ℝ) := sum_le_sum_of_subset_of_nonneg inter_subset_right (fun p _ _ ↦ Real.log_natCast_nonneg p) exact ⟨by dsimp; linarith [hVy.1], by dsimp; linarith [hVy.2]⟩ /-- A choice of a small-prime core yields the clustering upper bound. This is valid for every finite set of natural labels, without a primality assumption. -/ theorem primeSubsetSumSupport_measure_le_complement (T S : Finset ℕ) {d : ℝ} (hd : 0 ≤ d) : volume.real (primeSubsetSumSupport T d) ≤ (2 : ℝ) ^ (T \ S).card * ((∑ p ∈ S, log (p : ℝ)) + d) := by classical let c : (T \ S).powerset → ℝ := fun U ↦ ∑ p ∈ (U : Finset ℕ), log (p : ℝ) let L : ℝ := (∑ p ∈ S, log (p : ℝ)) + d have hL : 0 ≤ L := add_nonneg (sum_nonneg (fun p _ ↦ Real.log_natCast_nonneg p)) hd have hcompact : IsCompact (⋃ U : (T \ S).powerset, Set.Icc (c U) (c U + L)) := isCompact_iUnion (fun _ ↦ isCompact_Icc) have hcover : primeSubsetSumSupport T d ⊆ ⋃ U : (T \ S).powerset, Set.Icc (c U) (c U + L) := by simpa only [c, L, add_assoc] using primeSubsetSumSupport_complement_cover T S d calc _ ≤ volume.real (⋃ U : (T \ S).powerset, Set.Icc (c U) (c U + L)) := measureReal_mono hcover hcompact.measure_ne_top _ ≤ ∑ U : (T \ S).powerset, volume.real (Set.Icc (c U) (c U + L)) := measureReal_iUnion_fintype_le _ _ = _ := by simp [Real.volume_real_Icc, max_eq_left hL, L, mul_add] /-- The form used for ordered prime prefixes in Ford's divisor-interval bound. -/ theorem primeSubsetSumSupport_measure_le_core {T S : Finset ℕ} (hST : S ⊆ T) {d : ℝ} (hd : 0 ≤ d) : volume.real (primeSubsetSumSupport T d) ≤ (2 : ℝ) ^ (T.card - S.card) * ((∑ p ∈ S, log (p : ℝ)) + d) := by simpa only [card_sdiff_of_subset hST] using primeSubsetSumSupport_measure_le_complement T S hd theorem primeSubsetSumSupport_measure_le_card (T : Finset ℕ) {d : ℝ} (hd : 0 ≤ d) : volume.real (primeSubsetSumSupport T d) ≤ (2 : ℝ) ^ T.card * d := by simpa using primeSubsetSumSupport_measure_le_complement T ∅ hd theorem primeSubsetSumSupport_measure_le_span (T : Finset ℕ) {d : ℝ} (hd : 0 ≤ d) : volume.real (primeSubsetSumSupport T d) ≤ (∑ p ∈ T, log (p : ℝ)) + d := by simpa using primeSubsetSumSupport_measure_le_complement T T hd end Erdos859Verification end /- Inlined development module: SignedCubeMoments.lean -/ section /- Uniform finite signed coefficient boxes have centered, uncorrelated coordinates. -/ namespace Erdos859Verification open Finset Real def signedCoordinateFlip {ι : Type*} [DecidableEq ι] (i : ι) (c : ι → ℤ) : ι → ℤ := fun j ↦ if j = i then -c j else c j theorem signedCoordinateFlip_involutive {ι : Type*} [DecidableEq ι] (i : ι) : Function.Involutive (signedCoordinateFlip i) := by intro c funext j by_cases h : j = i <;> simp [signedCoordinateFlip, h] theorem signedCoordinateFlip_mem {ι : Type*} [Fintype ι] [DecidableEq ι] (i : ι) {H : ℕ} {c : ι → ℤ} (hc : c ∈ signedCoefficientBox ι H) : signedCoordinateFlip i c ∈ signedCoefficientBox ι H := by apply mem_signedCoefficientBox.mpr intro j have hj := mem_signedCoefficientBox.mp hc j by_cases h : j = i <;> simpa [signedCoordinateFlip, h] using hj theorem signedCoefficientBox_sum_flip {ι : Type*} [Fintype ι] [DecidableEq ι] (H : ℕ) (i : ι) (F : (ι → ℤ) → ℝ) : (∑ c ∈ signedCoefficientBox ι H, F (signedCoordinateFlip i c)) = ∑ c ∈ signedCoefficientBox ι H, F c := sum_nbij' (signedCoordinateFlip i) (signedCoordinateFlip i) (fun _ hc ↦ signedCoordinateFlip_mem i hc) (fun _ hc ↦ signedCoordinateFlip_mem i hc) (fun c _ ↦ signedCoordinateFlip_involutive i c) (fun c _ ↦ signedCoordinateFlip_involutive i c) (fun _ _ ↦ rfl) theorem signedCoefficientBox_coordinate_sum_zero {ι : Type*} [Fintype ι] (H : ℕ) (i : ι) : (∑ c ∈ signedCoefficientBox ι H, (c i : ℝ)) = 0 := by classical have h := signedCoefficientBox_sum_flip H i (fun c ↦ (c i : ℝ)) simp [signedCoordinateFlip] at h linarith theorem signedCoefficientBox_crossMoment_zero {ι : Type*} [Fintype ι] (H : ℕ) {i j : ι} (hij : i ≠ j) : (∑ c ∈ signedCoefficientBox ι H, (c i : ℝ) * (c j : ℝ)) = 0 := by classical have h := signedCoefficientBox_sum_flip H i (fun c ↦ (c i : ℝ) * (c j : ℝ)) simp [signedCoordinateFlip, hij.symm] at h linarith theorem signedCoefficientBox_linear_sum_zero {ι : Type*} [Fintype ι] (H : ℕ) (t : ι → ℝ) : (∑ c ∈ signedCoefficientBox ι H, ∑ i, (c i : ℝ) * t i) = 0 := by rw [sum_comm] simp_rw [← sum_mul, signedCoefficientBox_coordinate_sum_zero, zero_mul] exact sum_const_zero /-- All mixed terms cancel exactly; no properness condition is needed. -/ theorem signedCoefficientBox_secondMoment_diagonal {ι : Type*} [Fintype ι] (H : ℕ) (t : ι → ℝ) : (∑ c ∈ signedCoefficientBox ι H, (∑ i, (c i : ℝ) * t i) ^ 2) = ∑ i, (∑ c ∈ signedCoefficientBox ι H, (c i : ℝ) ^ 2) * t i ^ 2 := by classical calc _ = ∑ c ∈ signedCoefficientBox ι H, ∑ i, ∑ j, ((c i : ℝ) * (c j : ℝ)) * (t i * t j) := by apply sum_congr rfl intro c _ rw [sq, sum_mul_sum] apply sum_congr rfl intro i _ apply sum_congr rfl intro j _ ring _ = ∑ i, ∑ j, (∑ c ∈ signedCoefficientBox ι H, (c i : ℝ) * (c j : ℝ)) * (t i * t j) := by rw [sum_comm] apply sum_congr rfl intro i _ rw [sum_comm] simp only [sum_mul] _ = _ := by apply sum_congr rfl intro i _ rw [sum_eq_single i] · simp only [sq] · intro j _ hji rw [signedCoefficientBox_crossMoment_zero H hji.symm, zero_mul] · simp theorem signedCoefficientBox_coordinate_square_sum_le {ι : Type*} [Fintype ι] (H : ℕ) (i : ι) : (∑ c ∈ signedCoefficientBox ι H, (c i : ℝ) ^ 2) ≤ (((2 * H + 1) ^ Fintype.card ι : ℕ) : ℝ) * (H : ℝ) ^ 2 := by calc _ ≤ ∑ _c ∈ signedCoefficientBox ι H, (H : ℝ) ^ 2 := by apply sum_le_sum intro c hc have hci : |(c i : ℝ)| ≤ (H : ℝ) := by exact_mod_cast mem_signedCoefficientBox.mp hc i simpa only [sq_abs] using (sq_le_sq₀ (abs_nonneg (c i : ℝ)) (Nat.cast_nonneg H)).mpr hci _ = _ := by rw [sum_const, nsmul_eq_mul, card_signedCoefficientBox] /-- The normalized second moment is bounded by the sum of coordinate variances. -/ theorem signedCoefficientBox_secondMoment_le {ι : Type*} [Fintype ι] (H : ℕ) (t : ι → ℝ) : (∑ c ∈ signedCoefficientBox ι H, (∑ i, (c i : ℝ) * t i) ^ 2) / (((2 * H + 1) ^ Fintype.card ι : ℕ) : ℝ) ≤ (H : ℝ) ^ 2 * ∑ i, t i ^ 2 := by have hden : (0 : ℝ) < ((2 * H + 1) ^ Fintype.card ι : ℕ) := by positivity apply (div_le_iff₀ hden).mpr rw [signedCoefficientBox_secondMoment_diagonal] calc _ ≤ ∑ i, ((((2 * H + 1) ^ Fintype.card ι : ℕ) : ℝ) * (H : ℝ) ^ 2) * t i ^ 2 := sum_le_sum (fun i _ ↦ mul_le_mul_of_nonneg_right (signedCoefficientBox_coordinate_square_sum_le H i) (sq_nonneg _)) _ = _ := by rw [← mul_sum]; ring /-- Small coordinate phases force the real part of the uniform box transform to remain large, with a dimension-free quadratic loss. -/ theorem signedCoefficientBox_cos_lower {ι : Type*} [Fintype ι] (H : ℕ) (t : ι → ℝ) : 1 - 2 * Real.pi ^ 2 * (H : ℝ) ^ 2 * (∑ i, t i ^ 2) ≤ (∑ c ∈ signedCoefficientBox ι H, cos (2 * Real.pi * ∑ i, (c i : ℝ) * t i)) / (((2 * H + 1) ^ Fintype.card ι : ℕ) : ℝ) := by let M : ℝ := ((2 * H + 1) ^ Fintype.card ι : ℕ) have hM : 0 < M := by dsimp [M]; positivity have hcos : (∑ c ∈ signedCoefficientBox ι H, (1 - 2 * Real.pi ^ 2 * (∑ i, (c i : ℝ) * t i) ^ 2)) ≤ ∑ c ∈ signedCoefficientBox ι H, cos (2 * Real.pi * ∑ i, (c i : ℝ) * t i) := by apply sum_le_sum intro c _ have h := one_sub_sq_div_two_le_cos (x := 2 * Real.pi * ∑ i, (c i : ℝ) * t i) nlinarith only [h] have hsum : (∑ c ∈ signedCoefficientBox ι H, (1 - 2 * Real.pi ^ 2 * (∑ i, (c i : ℝ) * t i) ^ 2)) = M - 2 * Real.pi ^ 2 * ∑ c ∈ signedCoefficientBox ι H, (∑ i, (c i : ℝ) * t i) ^ 2 := by rw [sum_sub_distrib, ← mul_sum] simp only [sum_const, nsmul_eq_mul, mul_one, card_signedCoefficientBox, M] rw [hsum] at hcos have hmoment := signedCoefficientBox_secondMoment_le H t have hloss := mul_le_mul_of_nonneg_left hmoment (show 0 ≤ 2 * Real.pi ^ 2 by positivity) have hquot := div_le_div_of_nonneg_right hcos hM.le have hnorm : (M - 2 * Real.pi ^ 2 * ∑ c ∈ signedCoefficientBox ι H, (∑ i, (c i : ℝ) * t i) ^ 2) / M = 1 - 2 * Real.pi ^ 2 * ((∑ c ∈ signedCoefficientBox ι H, (∑ i, (c i : ℝ) * t i) ^ 2) / M) := by rw [sub_div, div_self hM.ne'] ring rw [hnorm] at hquot change _ ≤ _ / M change 2 * Real.pi ^ 2 * (_ / M) ≤ _ at hloss linarith end Erdos859Verification end /- Inlined development module: ProperCubeFourier.lean -/ section /- Exact Fourier energy of proper bounded signed cubes. -/ open Finset MeasureTheory open scoped ComplexConjugate namespace Erdos859Verification noncomputable def signedCubeValueSet {ι : Type*} [Fintype ι] (w : ι → ℕ) (H : ℕ) : Finset ℤ := (signedCoefficientBox ι H).image (signedCubeValue w) theorem zero_mem_signedCubeValueSet {ι : Type*} [Fintype ι] (w : ι → ℕ) (H : ℕ) : 0 ∈ signedCubeValueSet w H := by classical apply mem_image.mpr refine ⟨fun _ ↦ 0, mem_signedCoefficientBox.mpr (fun _ ↦ by simp), ?_⟩ simp [signedCubeValue] theorem proper_signedCubeValueSet_card {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) : (signedCubeValueSet w H).card = (2 * H + 1) ^ Fintype.card ι := by rw [signedCubeValueSet, card_image_of_injOn] · exact card_signedCoefficientBox ι H · intro c hc c' hc' heq exact hproper c c' (mem_signedCoefficientBox.mp hc) (mem_signedCoefficientBox.mp hc') heq noncomputable def integerSetFourierSum (S : Finset ℤ) : C(AddCircle (1 : ℝ), ℂ) := ∑ n ∈ S, fourier n theorem integerSetFourierSum_energy (S : Finset ℤ) : (∫ x : AddCircle (1 : ℝ), ‖integerSetFourierSum S x‖ ^ 2 ∂ AddCircle.haarAddCircle) = (S.card : ℝ) := by have horth := (orthonormal_fourier (T := (1 : ℝ))).inner_sum (fun _ : ℤ ↦ (1 : ℂ)) (fun _ : ℤ ↦ (1 : ℂ)) S have hmap : ContinuousMap.toLp 2 AddCircle.haarAddCircle ℂ (integerSetFourierSum S) = ∑ n ∈ S, fourierLp (T := (1 : ℝ)) 2 n := by simp only [integerSetFourierSum, map_sum, fourierLp] have hcomplex : (∫ x : AddCircle (1 : ℝ), integerSetFourierSum S x * conj (integerSetFourierSum S x) ∂ AddCircle.haarAddCircle) = (S.card : ℂ) := by rw [← ContinuousMap.inner_toLp, hmap] simpa only [one_smul, map_one, mul_one, sum_const, nsmul_eq_mul, mul_one] using horth simp only [Complex.mul_conj', ← Complex.ofReal_pow] at hcomplex exact_mod_cast hcomplex noncomputable def integerSetFourierMean (S : Finset ℤ) (x : AddCircle (1 : ℝ)) : ℂ := integerSetFourierSum S x / (S.card : ℂ) theorem integerSetFourierMean_energy {S : Finset ℤ} (hS : S.Nonempty) : (∫ x : AddCircle (1 : ℝ), ‖integerSetFourierMean S x‖ ^ 2 ∂ AddCircle.haarAddCircle) = 1 / (S.card : ℝ) := by have hcard : (S.card : ℝ) ≠ 0 := by exact_mod_cast card_ne_zero.mpr hS simp only [integerSetFourierMean, norm_div, Complex.norm_natCast, div_pow] rw [integral_div, integerSetFourierSum_energy] field_simp theorem proper_signedCubeFourier_energy {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) : (∫ x : AddCircle (1 : ℝ), ‖integerSetFourierMean (signedCubeValueSet w H) x‖ ^ 2 ∂ AddCircle.haarAddCircle) = 1 / (2 * (H : ℝ) + 1) ^ Fintype.card ι := by rw [integerSetFourierMean_energy ⟨0, zero_mem_signedCubeValueSet w H⟩, proper_signedCubeValueSet_card w hproper] push_cast rfl /-- Properness identifies the uniform set Fourier transform with the uniform average over all bounded coefficient vectors. -/ theorem proper_signedCubeFourier_eq_coefficients {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) (x : AddCircle (1 : ℝ)) : integerSetFourierMean (signedCubeValueSet w H) x = (∑ c ∈ signedCoefficientBox ι H, fourier (signedCubeValue w c) x) / ((2 * H + 1) ^ Fintype.card ι : ℕ) := by classical unfold integerSetFourierMean rw [proper_signedCubeValueSet_card w hproper] congr 1 simp only [integerSetFourierSum, ContinuousMap.sum_apply, signedCubeValueSet] apply sum_image intro c hc c' hc' heq exact hproper c c' (mem_signedCoefficientBox.mp hc) (mem_signedCoefficientBox.mp hc') heq end Erdos859Verification end /- Inlined development module: ProperCubeSmallPhases.lean -/ section /- Small coordinate phases of a proper cube occupy a small Haar-measure set. -/ open Finset MeasureTheory namespace Erdos859Verification noncomputable def cubePhaseSquare {ι : Type*} [Fintype ι] (w : ι → ℕ) (x : AddCircle (1 : ℝ)) : ℝ := ∑ i, ‖w i • x‖ ^ 2 theorem cubePhaseSquare_nonneg {ι : Type*} [Fintype ι] (w : ι → ℕ) (x : AddCircle (1 : ℝ)) : 0 ≤ cubePhaseSquare w x := sum_nonneg (fun _ _ ↦ sq_nonneg _) theorem continuous_cubePhaseSquare {ι : Type*} [Fintype ι] (w : ι → ℕ) : Continuous (cubePhaseSquare w) := by unfold cubePhaseSquare fun_prop theorem signedCube_fourier_re_centered {ι : Type*} [Fintype ι] (w : ι → ℕ) (c : ι → ℤ) (a : ℝ) : (fourier (signedCubeValue w c) (a : AddCircle (1 : ℝ))).re = Real.cos (2 * Real.pi * ∑ i, (c i : ℝ) * (a * (w i : ℝ) - (round (a * (w i : ℝ)) : ℤ))) := by have hphase : 2 * Real.pi * (signedCubeValue w c : ℝ) * a = (2 * Real.pi * ∑ i, (c i : ℝ) * (a * (w i : ℝ) - (round (a * (w i : ℝ)) : ℤ))) + ((∑ i, c i * round (a * (w i : ℝ)) : ℤ) : ℝ) * (2 * Real.pi) := by simp only [signedCubeValue, Int.cast_sum, Int.cast_mul, Int.cast_natCast] simp only [mul_sum, sum_mul, ← sum_add_distrib] apply sum_congr rfl intro i _ ring rw [fourier_coe_apply] simp only [Complex.ofReal_one] have hexp : (2 * (Real.pi : ℂ) * Complex.I * (signedCubeValue w c : ℂ) * a / 1) = ((2 * Real.pi * (signedCubeValue w c : ℝ) * a : ℝ) : ℂ) * Complex.I := by push_cast ring rw [hexp, Complex.exp_ofReal_mul_I_re, hphase, Real.cos_add_int_mul_two_pi] theorem proper_signedCubeFourier_re_lower {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) (x : AddCircle (1 : ℝ)) : 1 - 2 * Real.pi ^ 2 * (H : ℝ) ^ 2 * cubePhaseSquare w x ≤ (integerSetFourierMean (signedCubeValueSet w H) x).re := by induction x using QuotientAddGroup.induction_on with | H a => rw [proper_signedCubeFourier_eq_coefficients w hproper, Complex.div_natCast_re] simp only [Complex.re_sum, signedCube_fourier_re_centered] have hphase : cubePhaseSquare w (a : AddCircle (1 : ℝ)) = ∑ i, (a * (w i : ℝ) - (round (a * (w i : ℝ)) : ℤ)) ^ 2 := by unfold cubePhaseSquare apply sum_congr rfl intro i _ rw [← QuotientAddGroup.mk_nsmul, nsmul_eq_mul] simp only [mul_comm (w i : ℝ) a, UnitAddCircle.norm_eq, sq_abs] rw [hphase] exact signedCoefficientBox_cos_lower H _ theorem continuous_integerSetFourierMean (S : Finset ℤ) : Continuous (integerSetFourierMean S) := (integerSetFourierSum S).continuous.div_const _ theorem integerSetFourierMean_square_integrable (S : Finset ℤ) : Integrable (fun x : AddCircle (1 : ℝ) ↦ ‖integerSetFourierMean S x‖ ^ 2) AddCircle.haarAddCircle := ((continuous_integerSetFourierMean S).norm.pow 2).integrable_of_hasCompactSupport (HasCompactSupport.of_compactSpace _) /-- Markov's inequality and exact orthogonality bound large values of the normalized transform by its reciprocal cardinality. -/ theorem integerSetFourierMean_large_measure_le {S : Finset ℤ} (hS : S.Nonempty) {r : ℝ} (hr : 0 < r) : AddCircle.haarAddCircle.real {x : AddCircle (1 : ℝ) | r ≤ ‖integerSetFourierMean S x‖} ≤ 1 / (r ^ 2 * S.card) := by have hmarkov := mul_meas_ge_le_integral_of_nonneg (Filter.Eventually.of_forall (fun x : AddCircle (1 : ℝ) ↦ sq_nonneg ‖integerSetFourierMean S x‖)) (integerSetFourierMean_square_integrable S) (r ^ 2) have hset : {x : AddCircle (1 : ℝ) | r ^ 2 ≤ ‖integerSetFourierMean S x‖ ^ 2} = {x : AddCircle (1 : ℝ) | r ≤ ‖integerSetFourierMean S x‖} := by ext x exact sq_le_sq₀ hr.le (norm_nonneg _) rw [integerSetFourierMean_energy hS, hset] at hmarkov calc _ ≤ (1 / (S.card : ℝ)) / r ^ 2 := by apply (le_div_iff₀ (sq_pos_of_pos hr)).mpr simpa only [mul_comm] using hmarkov _ = _ := by ring /-- A dimension-free small-phase estimate, with the threshold stated explicitly. -/ theorem proper_cube_smallPhase_measure_le {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) {r e : ℝ} (hr : 0 < r) (hsmall : r ≤ 1 - 2 * Real.pi ^ 2 * (H : ℝ) ^ 2 * e) : AddCircle.haarAddCircle.real {x : AddCircle (1 : ℝ) | cubePhaseSquare w x ≤ e} ≤ 1 / (r ^ 2 * (2 * (H : ℝ) + 1) ^ Fintype.card ι) := by have hsubset : {x : AddCircle (1 : ℝ) | cubePhaseSquare w x ≤ e} ⊆ {x : AddCircle (1 : ℝ) | r ≤ ‖integerSetFourierMean (signedCubeValueSet w H) x‖} := by intro x hx have hmono := mul_le_mul_of_nonneg_left hx (show 0 ≤ 2 * Real.pi ^ 2 * (H : ℝ) ^ 2 by positivity) have hreal := proper_signedCubeFourier_re_lower w hproper x have hnorm := Complex.re_le_norm (integerSetFourierMean (signedCubeValueSet w H) x) change r ≤ ‖integerSetFourierMean (signedCubeValueSet w H) x‖ linarith calc _ ≤ AddCircle.haarAddCircle.real {x : AddCircle (1 : ℝ) | r ≤ ‖integerSetFourierMean (signedCubeValueSet w H) x‖} := measureReal_mono hsubset _ ≤ 1 / (r ^ 2 * (signedCubeValueSet w H).card) := integerSetFourierMean_large_measure_le ⟨0, zero_mem_signedCubeValueSet w H⟩ hr _ = _ := by rw [proper_signedCubeValueSet_card w hproper]; norm_cast /-- Moving a phase by a short circle distance increases its squared coordinate norm by a controlled amount. -/ theorem cubePhaseSquare_le_of_dist {ι : Type*} [Fintype ι] (w : ι → ℕ) (x y : AddCircle (1 : ℝ)) : cubePhaseSquare w y ≤ 2 * cubePhaseSquare w x + 2 * ((∑ i, w i : ℕ) : ℝ) ^ 2 * dist x y ^ 2 := by have hterm (i : ι) : ‖w i • y‖ ^ 2 ≤ 2 * ‖w i • x‖ ^ 2 + 2 * (w i : ℝ) ^ 2 * dist x y ^ 2 := by have hnorm : ‖w i • y‖ ≤ ‖w i • x‖ + (w i : ℝ) * dist x y := by calc _ = ‖w i • x + w i • (y - x)‖ := by congr 1; simp [nsmul_sub] _ ≤ ‖w i • x‖ + ‖w i • (y - x)‖ := norm_add_le _ _ _ ≤ ‖w i • x‖ + (w i : ℝ) * dist x y := by rw [dist_eq_norm, norm_sub_rev] exact add_le_add le_rfl norm_nsmul_le have hsq := (sq_le_sq₀ (norm_nonneg _) (by positivity)).mpr hnorm nlinarith only [hsq, sq_nonneg (‖w i • x‖ - (w i : ℝ) * dist x y)] have hweights : (∑ i, (w i : ℝ) ^ 2) ≤ ((∑ i, w i : ℕ) : ℝ) ^ 2 := by simpa only [Nat.cast_sum] using sum_sq_le_sq_sum_of_nonneg (s := univ) (fun i _ ↦ Nat.cast_nonneg (w i)) calc _ ≤ ∑ i, (2 * ‖w i • x‖ ^ 2 + 2 * (w i : ℝ) ^ 2 * dist x y ^ 2) := sum_le_sum (fun i _ ↦ hterm i) _ = 2 * cubePhaseSquare w x + 2 * (∑ i, (w i : ℝ) ^ 2) * dist x y ^ 2 := by rw [sum_add_distrib] simp only [cubePhaseSquare, ← mul_sum, ← sum_mul] _ ≤ _ := by gcongr def cubeSmallPhaseNeighborhood {ι : Type*} [Fintype ι] (w : ι → ℕ) (e d : ℝ) : Set (AddCircle (1 : ℝ)) := {y | ∃ x, cubePhaseSquare w x ≤ e ∧ dist x y ≤ d} theorem proper_cube_smallPhase_neighborhood_measure_le {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) {r e d : ℝ} (hr : 0 < r) (hd : 0 ≤ d) (hsmall : r ≤ 1 - 2 * Real.pi ^ 2 * (H : ℝ) ^ 2 * (2 * e + 2 * ((∑ i, w i : ℕ) : ℝ) ^ 2 * d ^ 2)) : AddCircle.haarAddCircle.real (cubeSmallPhaseNeighborhood w e d) ≤ 1 / (r ^ 2 * (2 * (H : ℝ) + 1) ^ Fintype.card ι) := by have hsubset : cubeSmallPhaseNeighborhood w e d ⊆ {y | cubePhaseSquare w y ≤ 2 * e + 2 * ((∑ i, w i : ℕ) : ℝ) ^ 2 * d ^ 2} := by rintro y ⟨x, hx, hxy⟩ have hsq := (sq_le_sq₀ dist_nonneg hd).mpr hxy exact (cubePhaseSquare_le_of_dist w x y).trans (by gcongr) exact (measureReal_mono hsubset).trans (proper_cube_smallPhase_measure_le w hproper hr hsmall) /-- A concrete neighborhood bound sufficient for the rational-arc argument. -/ theorem proper_cube_smallPhase_neighborhood_measure {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) {Y : ℝ} (hY : 0 < Y) (hYH : 32 * (H : ℝ) ≤ Y) (hW : 0 < ∑ i, w i) : AddCircle.haarAddCircle.real (cubeSmallPhaseNeighborhood w ((1 / Y) ^ 2) (1 / (Y * ∑ i, (w i : ℝ)))) ≤ 16 / (9 * (2 * (H : ℝ) + 1) ^ Fintype.card ι) := by have hWR : (0 : ℝ) < ∑ i, (w i : ℝ) := by exact_mod_cast hW have he : 2 * (1 / Y) ^ 2 + 2 * ((∑ i, w i : ℕ) : ℝ) ^ 2 * (1 / (Y * ∑ i, (w i : ℝ))) ^ 2 = 4 / Y ^ 2 := by rw [Nat.cast_sum] field_simp ring have hpi : Real.pi ^ 2 ≤ 16 := by nlinarith [Real.pi_lt_four, Real.pi_pos] have hHY : (32 * (H : ℝ)) ^ 2 ≤ Y ^ 2 := (sq_le_sq₀ (by positivity) hY.le).mpr hYH have hloss : 2 * Real.pi ^ 2 * (H : ℝ) ^ 2 * (4 / Y ^ 2) ≤ 1 / 4 := by rw [← mul_div_assoc, div_le_iff₀ (sq_pos_of_pos hY)] have hm := mul_le_mul_of_nonneg_right hpi (sq_nonneg (H : ℝ)) nlinarith have hsmall : (3 : ℝ) / 4 ≤ 1 - 2 * Real.pi ^ 2 * (H : ℝ) ^ 2 * (2 * (1 / Y) ^ 2 + 2 * ((∑ i, w i : ℕ) : ℝ) ^ 2 * (1 / (Y * ∑ i, (w i : ℝ))) ^ 2) := by rw [he]; linarith have h := proper_cube_smallPhase_neighborhood_measure_le w hproper (by norm_num : (0 : ℝ) < 3 / 4) (by positivity : 0 ≤ 1 / (Y * ∑ i, (w i : ℝ))) hsmall convert h using 1 ring end Erdos859Verification end /- Inlined development module: CirclePhaseGrid.lean -/ section /- Finite packing estimates for rational grids on the unit circle. -/ namespace Erdos859Verification open Finset MeasureTheory Metric def circleClosedNeighborhood (F : Set (AddCircle (1 : ℝ))) (d : ℝ) : Set (AddCircle (1 : ℝ)) := {y | ∃ x ∈ F, dist x y ≤ d} theorem unitCircle_haar_eq_volume : (AddCircle.haarAddCircle : Measure (AddCircle (1 : ℝ))) = volume := by simpa only [ENNReal.ofReal_one, one_smul] using (AddCircle.volume_eq_smul_haarAddCircle (T := (1 : ℝ))).symm theorem unitCircle_ball_measureReal (x : AddCircle (1 : ℝ)) {r : ℝ} (hr : 0 ≤ r) : AddCircle.haarAddCircle.real (ball x r) = min 1 (2 * r) := by rw [unitCircle_haar_eq_volume, measureReal_def, ← measure_congr (AddCircle.closedBall_ae_eq_ball (x := x) (ε := r)), AddCircle.volume_closedBall, ENNReal.toReal_ofReal] exact le_min (by norm_num) (by positivity) /-- Disjoint equal-radius arcs have their exact Euclidean total length. -/ theorem circle_separated_balls_measure {α : Type*} (S : Finset α) (x : α → AddCircle (1 : ℝ)) {r : ℝ} (hr : 0 ≤ r) (hrhalf : r ≤ 1 / 2) (hsep : ∀ i ∈ S, ∀ j ∈ S, i ≠ j → 2 * r ≤ dist (x i) (x j)) : AddCircle.haarAddCircle.real (⋃ i ∈ S, ball (x i) r) = (S.card : ℝ) * (2 * r) := by rw [measureReal_biUnion_finset] · simp only [unitCircle_ball_measureReal _ hr, min_eq_right (by linarith : 2 * r ≤ 1), sum_const, nsmul_eq_mul] · intro i hi j hj hij exact ball_disjoint_ball (by simpa only [two_mul] using hsep i hi j hj hij) · intro _ _ exact measurableSet_ball theorem circle_separated_balls_bound {α : Type*} (S : Finset α) (x : α → AddCircle (1 : ℝ)) {r : ℝ} (hr : 0 ≤ r) (hrhalf : r ≤ 1 / 2) (hsep : ∀ i ∈ S, ∀ j ∈ S, i ≠ j → 2 * r ≤ dist (x i) (x j)) {E : Set (AddCircle (1 : ℝ))} (hsub : ∀ i ∈ S, ball (x i) r ⊆ E) : (S.card : ℝ) * (2 * r) ≤ AddCircle.haarAddCircle.real E := by rw [← circle_separated_balls_measure S x hr hrhalf hsep] apply measureReal_mono _ (measure_ne_top _ _) intro y hy obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hy obtain ⟨hiS, hiy⟩ := Set.mem_iUnion.mp hi exact hsub i hiS hiy /-- A separated family cannot put more than `2R/delta+1` points in an arc. -/ theorem circle_separated_card_in_ball_le {α : Type*} (S : Finset α) (x : α → AddCircle (1 : ℝ)) {delta R : ℝ} (hdelta : 0 < delta) (hdelta1 : delta ≤ 1) (hR : 0 ≤ R) (hsep : ∀ i ∈ S, ∀ j ∈ S, i ≠ j → delta ≤ dist (x i) (x j)) (z : AddCircle (1 : ℝ)) (hball : ∀ i ∈ S, dist (x i) z ≤ R) : (S.card : ℝ) ≤ 2 * R / delta + 1 := by have h := circle_separated_balls_bound S x (r := delta / 2) (by positivity) (by linarith) (by simpa only [mul_div_cancel₀ _ (by norm_num : (2 : ℝ) ≠ 0)] using hsep) (E := ball z (R + delta / 2)) (by intro i hi y hy have hyi : dist (x i) y < delta / 2 := by simpa only [mem_ball, dist_comm] using hy have hz := dist_triangle z (x i) y have hiR := hball i hi rw [dist_comm (x i) z] at hiR change dist y z < R + delta / 2 rw [dist_comm y z] linarith) rw [unitCircle_ball_measureReal _ (by positivity)] at h have hmin : min (1 : ℝ) (2 * (R + delta / 2)) ≤ 2 * (R + delta / 2) := min_le_right _ _ have hbound : (S.card : ℝ) * delta ≤ 2 * R + delta := by linarith have heq : (2 * R / delta + 1) * delta = 2 * R + delta := by field_simp nlinarith only [hbound, heq, hdelta] theorem circle_separated_card_neighborhood_le {α : Type*} (S : Finset α) (x : α → AddCircle (1 : ℝ)) {delta d : ℝ} (hdelta : 0 < delta) (hd : 0 < d) (hdhalf : d ≤ 1 / 2) (hsep : ∀ i ∈ S, ∀ j ∈ S, i ≠ j → delta ≤ dist (x i) (x j)) (F : Set (AddCircle (1 : ℝ))) (hF : ∀ i ∈ S, x i ∈ F) : (S.card : ℝ) ≤ (1 / d + 1 / delta) * AddCircle.haarAddCircle.real (circleClosedNeighborhood F d) := by let r := min d (delta / 2) have hr : 0 < r := lt_min hd (half_pos hdelta) have hrhalf : r ≤ 1 / 2 := (min_le_left _ _).trans hdhalf have hsep' : ∀ i ∈ S, ∀ j ∈ S, i ≠ j → 2 * r ≤ dist (x i) (x j) := by intro i hi j hj hij exact (show 2 * r ≤ delta by dsimp [r]; linarith [min_le_right d (delta / 2)]).trans (hsep i hi j hj hij) have h := circle_separated_balls_bound S x hr.le hrhalf hsep' (E := circleClosedNeighborhood F d) (by intro i hi y hy refine ⟨x i, hF i hi, ?_⟩ have hxy : dist (x i) y < r := by simpa only [mem_ball, dist_comm] using hy exact hxy.le.trans (min_le_left _ _)) have hbound : (S.card : ℝ) ≤ AddCircle.haarAddCircle.real (circleClosedNeighborhood F d) / (2 * r) := (le_div_iff₀ (by positivity : 0 < 2 * r)).mpr h have hcoeff : 1 / (2 * r) ≤ 1 / d + 1 / delta := by rcases le_total d (delta / 2) with hle | hle · have hrEq : r = d := min_eq_left hle rw [hrEq] have hrecip : 1 / (2 * d) ≤ 1 / d := one_div_le_one_div_of_le hd (by linarith) have hpos : 0 ≤ 1 / delta := by positivity linarith · have hrEq : r = delta / 2 := min_eq_right hle rw [hrEq] have hpos : 0 ≤ 1 / d := by positivity have heq : 1 / (2 * (delta / 2)) = 1 / delta := by ring rw [heq] linarith exact hbound.trans (by simpa only [div_eq_mul_inv, one_div, mul_comm, one_mul, mul_one] using mul_le_mul_of_nonneg_right hcoeff (measureReal_nonneg : 0 ≤ AddCircle.haarAddCircle.real (circleClosedNeighborhood F d))) noncomputable def circleRationalGridPoint (q : ℕ) (a : Fin q) : AddCircle (1 : ℝ) := a.val • (((1 : ℝ) / q : ℝ) : AddCircle (1 : ℝ)) theorem circleRationalGridPoint_eq_div (q : ℕ) (a : Fin q) : circleRationalGridPoint q a = (((a.val : ℝ) / q : ℝ) : AddCircle (1 : ℝ)) := by unfold circleRationalGridPoint rw [← AddCircle.coe_nsmul, nsmul_eq_mul, mul_one_div] theorem circleRationalGridPoint_injective {q : ℕ} (hq : 0 < q) : Function.Injective (circleRationalGridPoint q) := by intro a b hab apply Fin.ext apply nsmul_injOn_Iio_addOrderOf (x := (((1 : ℝ) / q : ℝ) : AddCircle (1 : ℝ))) (by simpa only [Set.mem_Iio, AddCircle.addOrderOf_period_div hq] using a.isLt) (by simpa only [Set.mem_Iio, AddCircle.addOrderOf_period_div hq] using b.isLt) exact hab theorem circle_torsion_dist_lower {q : ℕ} (hq : 0 < q) {x y : AddCircle (1 : ℝ)} (hx : q • x = 0) (hy : q • y = 0) (hxy : x ≠ y) : 1 / (q : ℝ) ≤ dist x y := by have hzero : q • (x - y) = 0 := by rw [nsmul_sub, hx, hy, sub_self] have hfin : IsOfFinAddOrder (x - y) := isOfFinAddOrder_iff_nsmul_eq_zero.mpr ⟨q, hq, hzero⟩ have hord : addOrderOf (x - y) ≤ q := Nat.le_of_dvd hq (addOrderOf_dvd_iff_nsmul_eq_zero.mpr hzero) have hnorm := AddCircle.le_add_order_smul_norm_of_isOfFinAddOrder hfin (sub_ne_zero.mpr hxy) have hsmul : addOrderOf (x - y) • ‖x - y‖ ≤ q • ‖x - y‖ := nsmul_le_nsmul_left (norm_nonneg _) hord simp only [nsmul_eq_mul] at hnorm hsmul rw [dist_eq_norm] exact (div_le_iff₀ (by exact_mod_cast hq : (0 : ℝ) < q)).mpr (by nlinarith) theorem circleRationalGridPoint_separated {q : ℕ} (hq : 0 < q) : ∀ a b : Fin q, a ≠ b → 1 / (q : ℝ) ≤ dist (circleRationalGridPoint q a) (circleRationalGridPoint q b) := by have hz (a : Fin q) : q • circleRationalGridPoint q a = 0 := by unfold circleRationalGridPoint rw [smul_comm] have h := addOrderOf_nsmul_eq_zero (((1 : ℝ) / q : ℝ) : AddCircle (1 : ℝ)) rw [AddCircle.addOrderOf_period_div hq] at h rw [h, smul_zero] intro a b hab exact circle_torsion_dist_lower hq (hz a) (hz b) (fun h ↦ hab (circleRationalGridPoint_injective hq h)) theorem circleRationalGrid_card_neighborhood_le {q : ℕ} (hq : 0 < q) (S : Finset (Fin q)) {d : ℝ} (hd : 0 < d) (hdhalf : d ≤ 1 / 2) (F : Set (AddCircle (1 : ℝ))) (hF : ∀ a ∈ S, circleRationalGridPoint q a ∈ F) : (S.card : ℝ) ≤ ((q : ℝ) + 1 / d) * AddCircle.haarAddCircle.real (circleClosedNeighborhood F d) := by have hqR : (0 : ℝ) < q := by exact_mod_cast hq have h := circle_separated_card_neighborhood_le S (circleRationalGridPoint q) (by positivity : 0 < 1 / (q : ℝ)) hd hdhalf (fun a _ b _ hab ↦ circleRationalGridPoint_separated hq a b hab) F hF simpa only [one_div_one_div, add_comm] using h /-- A maximal separated subfamily of finitely many points covers them all. -/ theorem exists_finite_separated_cover {α X : Type*} [PseudoMetricSpace X] (S : Finset α) (x : α → X) {d : ℝ} (hd : 0 < d) : ∃ J : Finset α, J ⊆ S ∧ (∀ i ∈ J, ∀ j ∈ J, i ≠ j → d ≤ dist (x i) (x j)) ∧ ∀ i ∈ S, ∃ j ∈ J, dist (x i) (x j) < d := by classical let Sep : Finset α → Prop := fun J ↦ ∀ i ∈ J, ∀ j ∈ J, i ≠ j → d ≤ dist (x i) (x j) let : DecidablePred Sep := fun _ ↦ Classical.propDecidable _ let A := S.powerset.filter Sep have hA : A.Nonempty := ⟨∅, by simp [A, Sep]⟩ obtain ⟨J, hJ, hmax⟩ := A.exists_max_image Finset.card hA obtain ⟨hJS, hsep⟩ := mem_filter.mp hJ change ∀ i ∈ J, ∀ j ∈ J, i ≠ j → d ≤ dist (x i) (x j) at hsep have hsub : J ⊆ S := mem_powerset.mp hJS refine ⟨J, hsub, hsep, ?_⟩ intro i hi by_contra hn push Not at hn have hiJ : i ∉ J := by intro h have hdist := hn i h simp only [dist_self] at hdist linarith have hnew : insert i J ∈ A := by apply mem_filter.mpr refine ⟨mem_powerset.mpr (insert_subset hi hsub), ?_⟩ change ∀ a ∈ insert i J, ∀ b ∈ insert i J, a ≠ b → d ≤ dist (x a) (x b) intro a ha b hb hab rcases mem_insert.mp ha with hai | haJ · subst a rcases mem_insert.mp hb with hbi | hbJ · exact False.elim (hab hbi.symm) · exact hn b hbJ · rcases mem_insert.mp hb with hbi | hbJ · simpa only [hbi, dist_comm] using hn a haJ · exact hsep a haJ b hbJ hab have hc := hmax (insert i J) hnew rw [card_insert_of_notMem hiJ] at hc omega /-- Grid points may be moved to nearby witnesses before packing. This handles rational arcs meeting a phase set, rather than only grid points in the set. -/ theorem circle_separated_near_card_le {α : Type*} (S : Finset α) (g x : α → AddCircle (1 : ℝ)) {delta d e : ℝ} (hdelta : 0 < delta) (hdelta1 : delta ≤ 1) (hd : 0 < d) (hdhalf : d ≤ 1 / 2) (he : 0 ≤ e) (hsep : ∀ i ∈ S, ∀ j ∈ S, i ≠ j → delta ≤ dist (g i) (g j)) (F : Set (AddCircle (1 : ℝ))) (hF : ∀ i ∈ S, x i ∈ F) (hnear : ∀ i ∈ S, dist (g i) (x i) ≤ e) : (S.card : ℝ) ≤ ((2 * (d + e) / delta + 1) / d) * AddCircle.haarAddCircle.real (circleClosedNeighborhood F d) := by classical obtain ⟨J, hJS, hJsep, hcover⟩ := exists_finite_separated_cover S x hd have hmeasure : (J.card : ℝ) * d ≤ AddCircle.haarAddCircle.real (circleClosedNeighborhood F d) := by have h := circle_separated_balls_bound J x (r := d / 2) (by positivity) (by linarith) (by simpa only [mul_div_cancel₀ _ (by norm_num : (2 : ℝ) ≠ 0)] using hJsep) (E := circleClosedNeighborhood F d) (by intro j hj y hy refine ⟨x j, hF j (hJS hj), ?_⟩ have hxy : dist (x j) y < d / 2 := by simpa only [mem_ball, dist_comm] using hy linarith) simpa only [mul_div_cancel₀ _ (by norm_num : (2 : ℝ) ≠ 0)] using h let B : α → Finset α := fun j ↦ S.filter (fun i ↦ dist (g i) (x j) ≤ d + e) have hsub : S ⊆ J.biUnion B := by intro i hi obtain ⟨j, hj, hij⟩ := hcover i hi apply mem_biUnion.mpr refine ⟨j, hj, mem_filter.mpr ⟨hi, ?_⟩⟩ have htriangle := dist_triangle (g i) (x i) (x j) have hclose := hnear i hi linarith have hlocal (j : α) : ((B j).card : ℝ) ≤ 2 * (d + e) / delta + 1 := by apply circle_separated_card_in_ball_le (B j) g hdelta hdelta1 (by positivity) (fun i hi l hl hil ↦ hsep i (mem_filter.mp hi).1 l (mem_filter.mp hl).1 hil) (x j) intro i hi exact (mem_filter.mp hi).2 have hcount : (S.card : ℝ) ≤ (J.card : ℝ) * (2 * (d + e) / delta + 1) := by calc _ ≤ ∑ j ∈ J, ((B j).card : ℝ) := by exact_mod_cast (card_le_card hsub).trans card_biUnion_le _ ≤ ∑ _j ∈ J, (2 * (d + e) / delta + 1) := sum_le_sum (fun j _ ↦ hlocal j) _ = _ := by simp; ring have hC : 0 ≤ 2 * (d + e) / delta + 1 := by positivity have h1 := mul_le_mul_of_nonneg_right hcount hd.le have h2 := mul_le_mul_of_nonneg_left hmeasure hC have heq : (((2 * (d + e) / delta + 1) / d) * AddCircle.haarAddCircle.real (circleClosedNeighborhood F d)) * d = (2 * (d + e) / delta + 1) * AddCircle.haarAddCircle.real (circleClosedNeighborhood F d) := by field_simp nlinarith only [h1, h2, heq, hd] theorem circleRationalGrid_near_card_neighborhood_le {q : ℕ} (hq : 0 < q) (S : Finset (Fin q)) {d : ℝ} (hd : 0 < d) (hdhalf : d ≤ 1 / 2) (F : Set (AddCircle (1 : ℝ))) (hnear : ∀ a ∈ S, ∃ x ∈ F, dist (circleRationalGridPoint q a) x ≤ 1 / (q : ℝ)) : (S.card : ℝ) ≤ (2 * (q : ℝ) + 3 / d) * AddCircle.haarAddCircle.real (circleClosedNeighborhood F d) := by classical have hqR : (0 : ℝ) < q := by exact_mod_cast hq have hq1 : (1 : ℝ) ≤ q := by exact_mod_cast hq let x : Fin q → AddCircle (1 : ℝ) := fun a ↦ if ha : a ∈ S then (hnear a ha).choose else 0 have hx (a : Fin q) (ha : a ∈ S) : x a ∈ F ∧ dist (circleRationalGridPoint q a) (x a) ≤ 1 / (q : ℝ) := by simpa only [x, dif_pos ha] using (hnear a ha).choose_spec have h := circle_separated_near_card_le S (circleRationalGridPoint q) x (by positivity : 0 < 1 / (q : ℝ)) (by simpa using one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 1) hq1) hd hdhalf (by positivity : 0 ≤ 1 / (q : ℝ)) (fun a _ b _ hab ↦ circleRationalGridPoint_separated hq a b hab) F (fun a ha ↦ (hx a ha).1) (fun a ha ↦ (hx a ha).2) have heq : (2 * (d + 1 / (q : ℝ)) / (1 / (q : ℝ)) + 1) / d = 2 * (q : ℝ) + 3 / d := by field_simp; ring rwa [heq] at h end Erdos859Verification end /- Inlined development module: ProperCubeRationalGrid.lean -/ section /- Rational phase counts and one-prime bounds for proper signed cubes. -/ namespace Erdos859Verification open Finset Real theorem proper_cube_exact_grid_card_le {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) {Y : ℝ} (hY : 0 < Y) (hYH : 32 * (H : ℝ) ≤ Y) (hW : 0 < ∑ i, w i) (hscale : 2 ≤ Y * ∑ i, (w i : ℝ)) {q : ℕ} (hq : 0 < q) (S : Finset (Fin q)) (hS : ∀ a ∈ S, cubePhaseSquare w (circleRationalGridPoint q a) ≤ (1 / Y) ^ 2) : (S.card : ℝ) ≤ 2 * ((q : ℝ) + Y * ∑ i, (w i : ℝ)) / (2 * (H : ℝ) + 1) ^ Fintype.card ι := by have hWR : (0 : ℝ) < ∑ i, (w i : ℝ) := by exact_mod_cast hW have hd : 0 < 1 / (Y * ∑ i, (w i : ℝ)) := by positivity have hdhalf : 1 / (Y * ∑ i, (w i : ℝ)) ≤ 1 / 2 := one_div_le_one_div_of_le (by norm_num) hscale have h := circleRationalGrid_card_neighborhood_le hq S hd hdhalf {x | cubePhaseSquare w x ≤ (1 / Y) ^ 2} hS have hm := proper_cube_smallPhase_neighborhood_measure w hproper hY hYH hW change AddCircle.haarAddCircle.real (circleClosedNeighborhood {x | cubePhaseSquare w x ≤ (1 / Y) ^ 2} (1 / (Y * ∑ i, (w i : ℝ)))) ≤ _ at hm have hM : 0 < (2 * (H : ℝ) + 1) ^ Fintype.card ι := by positivity calc _ ≤ ((q : ℝ) + Y * ∑ i, (w i : ℝ)) * (16 / (9 * (2 * (H : ℝ) + 1) ^ Fintype.card ι)) := by apply h.trans simpa only [one_div_one_div] using mul_le_mul_of_nonneg_left hm (show 0 ≤ (q : ℝ) + 1 / (1 / (Y * ∑ i, (w i : ℝ))) by positivity) _ ≤ _ := by apply (le_div_iff₀ hM).mpr have heq : (((q : ℝ) + Y * ∑ i, (w i : ℝ)) * (16 / (9 * (2 * (H : ℝ) + 1) ^ Fintype.card ι))) * (2 * (H : ℝ) + 1) ^ Fintype.card ι = (16 / 9) * ((q : ℝ) + Y * ∑ i, (w i : ℝ)) := by field_simp rw [heq] have hn : 0 ≤ (q : ℝ) + Y * ∑ i, (w i : ℝ) := by positivity nlinarith theorem proper_cube_near_grid_card_le {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) {Y : ℝ} (hY : 0 < Y) (hYH : 32 * (H : ℝ) ≤ Y) (hW : 0 < ∑ i, w i) (hscale : 2 ≤ Y * ∑ i, (w i : ℝ)) {q : ℕ} (hq : 0 < q) (S : Finset (Fin q)) (hS : ∀ a ∈ S, ∃ x : AddCircle (1 : ℝ), cubePhaseSquare w x ≤ (1 / Y) ^ 2 ∧ dist (circleRationalGridPoint q a) x ≤ 1 / (q : ℝ)) : (S.card : ℝ) ≤ 6 * ((q : ℝ) + Y * ∑ i, (w i : ℝ)) / (2 * (H : ℝ) + 1) ^ Fintype.card ι := by have hWR : (0 : ℝ) < ∑ i, (w i : ℝ) := by exact_mod_cast hW have hd : 0 < 1 / (Y * ∑ i, (w i : ℝ)) := by positivity have hdhalf : 1 / (Y * ∑ i, (w i : ℝ)) ≤ 1 / 2 := one_div_le_one_div_of_le (by norm_num) hscale have h := circleRationalGrid_near_card_neighborhood_le hq S hd hdhalf {x | cubePhaseSquare w x ≤ (1 / Y) ^ 2} hS have hm := proper_cube_smallPhase_neighborhood_measure w hproper hY hYH hW change AddCircle.haarAddCircle.real (circleClosedNeighborhood {x | cubePhaseSquare w x ≤ (1 / Y) ^ 2} (1 / (Y * ∑ i, (w i : ℝ)))) ≤ _ at hm have hM : 0 < (2 * (H : ℝ) + 1) ^ Fintype.card ι := by positivity have hmul := mul_le_mul_of_nonneg_left hm (show 0 ≤ 2 * (q : ℝ) + 3 / (1 / (Y * ∑ i, (w i : ℝ))) by positivity) have hid : 3 / (1 / (Y * ∑ i, (w i : ℝ))) = 3 * (Y * ∑ i, (w i : ℝ)) := by simp only [div_eq_mul_inv, one_mul, inv_inv] rw [hid] at hmul calc _ ≤ (2 * (q : ℝ) + 3 * (Y * ∑ i, (w i : ℝ))) * (16 / (9 * (2 * (H : ℝ) + 1) ^ Fintype.card ι)) := by exact h.trans (by simpa only [hid] using hmul) _ ≤ _ := by apply (le_div_iff₀ hM).mpr have heq : ((2 * (q : ℝ) + 3 * (Y * ∑ i, (w i : ℝ))) * (16 / (9 * (2 * (H : ℝ) + 1) ^ Fintype.card ι))) * (2 * (H : ℝ) + 1) ^ Fintype.card ι = (16 / 9) * (2 * (q : ℝ) + 3 * (Y * ∑ i, (w i : ℝ))) := by field_simp rw [heq] have hn : 0 ≤ Y * ∑ i, (w i : ℝ) := by positivity have hq0 : (0 : ℝ) ≤ q := Nat.cast_nonneg q nlinarith /-- A reduced numerator permutes residue fibers; this proof needs no chosen inverse. -/ theorem finite_weighted_mul_residue_le (P : Finset ℕ) (weight : ℕ → ℝ) {a q : ℕ} (hcop : Nat.Coprime a q) {B : ℝ} (hB : 0 ≤ B) (hw : ∀ p ∈ P, 0 ≤ weight p) (hres : ∀ r : ℕ, (∑ p ∈ P.filter (fun p ↦ Nat.ModEq q p r), weight p) ≤ B) (r : ℕ) : (∑ p ∈ P.filter (fun p ↦ Nat.ModEq q (p * a) r), weight p) ≤ B := by classical by_cases hex : ∃ p ∈ P, Nat.ModEq q (p * a) r · obtain ⟨p₀, hp₀, hr₀⟩ := hex apply le_trans _ (hres p₀) apply sum_le_sum_of_subset_of_nonneg · intro p hp refine mem_filter.mpr ⟨(mem_filter.mp hp).1, ?_⟩ exact Nat.ModEq.cancel_right_of_coprime hcop.symm.gcd_eq_one ((mem_filter.mp hp).2.trans hr₀.symm) · intro p hp _ exact hw p (mem_filter.mp hp).1 · have hempty : P.filter (fun p ↦ Nat.ModEq q (p * a) r) = ∅ := by apply eq_empty_iff_forall_notMem.mpr intro p hp exact hex ⟨p, (mem_filter.mp hp).1, (mem_filter.mp hp).2⟩ simpa only [hempty, sum_empty] using hB theorem finite_weighted_mul_residues_le (P : Finset ℕ) (weight : ℕ → ℝ) {a q : ℕ} (hcop : Nat.Coprime a q) {B : ℝ} (hB : 0 ≤ B) (hw : ∀ p ∈ P, 0 ≤ weight p) (hres : ∀ r : ℕ, (∑ p ∈ P.filter (fun p ↦ Nat.ModEq q p r), weight p) ≤ B) (S : Finset (Fin q)) : (∑ p ∈ P.filter (fun p ↦ ∃ r ∈ S, Nat.ModEq q (p * a) r.val), weight p) ≤ (S.card : ℝ) * B := by classical have hu := finite_weighted_union_bound_general P S weight hw (fun r p ↦ Nat.ModEq q (p * a) r.val) simp only [mul_ite, mul_one, mul_zero, ← sum_filter] at hu calc _ ≤ ∑ r ∈ S, ∑ p ∈ P.filter (fun p ↦ Nat.ModEq q (p * a) r.val), weight p := hu _ ≤ ∑ _r ∈ S, B := sum_le_sum (fun r _ ↦ finite_weighted_mul_residue_le P weight hcop hB hw hres r.val) _ = _ := by simp theorem primeLogOddsMark_broad_residue_upper {lam v eps : ℝ} {q a : ℕ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) (hq : 0 < q) : (∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter (fun p ↦ Nat.ModEq q p a), primeLogOddsMarkWeight lam v ((1 + eps) * v) p) ≤ 16 * v / (q : ℝ) + 16 * exp (-v) / eps := by have hv0 : 0 < v := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv have hvb : v ≤ (1 + eps) * v := by nlinarith have hmass := primeLogOddsIntensity_broad_mass_lower hlam hlam2 hv heps heps1 hlarge have hmasspos : 0 < ∑ p ∈ primeLogWindow v ((1 + eps) * v), primeLogOddsIntensity lam p := (by positivity : 0 < eps / 4).trans_le hmass have hnum : (∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter (fun p ↦ Nat.ModEq q p a), primeLogOddsIntensity lam p) ≤ 4 * (exp (-v) + ((1 + eps) * v - v) / (q : ℝ)) := by calc _ ≤ ∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter (fun p ↦ Nat.ModEq q p a), 4 / (p : ℝ) := sum_le_sum (fun p hp ↦ (primeLogOddsIntensity_bounds hlam hlam2 (mem_primeLogWindow.mp (mem_filter.mp hp).1).1).2) _ = 4 * ∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter (fun p ↦ Nat.ModEq q p a), 1 / (p : ℝ) := by simp only [mul_one_div, mul_sum] _ ≤ _ := mul_le_mul_of_nonneg_left (primeLogWindow_residue_mass_upper hq hvb) (by norm_num) simp only [primeLogOddsMarkWeight, ← sum_div] calc _ ≤ (4 * (exp (-v) + ((1 + eps) * v - v) / (q : ℝ))) / (∑ p ∈ primeLogWindow v ((1 + eps) * v), primeLogOddsIntensity lam p) := div_le_div_of_nonneg_right hnum hmasspos.le _ ≤ (4 * (exp (-v) + ((1 + eps) * v - v) / (q : ℝ))) / (eps / 4) := div_le_div_of_nonneg_left (by positivity) (by positivity) hmass _ = _ := by field_simp; ring theorem proper_cube_near_grid_logOddsMark_weight_le {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) {Y : ℝ} (hY : 0 < Y) (hYH : 32 * (H : ℝ) ≤ Y) (hW : 0 < ∑ i, w i) (hscale : 2 ≤ Y * ∑ i, (w i : ℝ)) {q a : ℕ} (hq : 0 < q) (hcop : Nat.Coprime a q) (S : Finset (Fin q)) (hS : ∀ r ∈ S, ∃ x : AddCircle (1 : ℝ), cubePhaseSquare w x ≤ (1 / Y) ^ 2 ∧ dist (circleRationalGridPoint q r) x ≤ 1 / (q : ℝ)) {lam v eps : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) : (∑ p ∈ (primeLogWindow v ((1 + eps) * v)).filter (fun p ↦ ∃ r ∈ S, Nat.ModEq q (p * a) r.val), primeLogOddsMarkWeight lam v ((1 + eps) * v) p) ≤ (6 * ((q : ℝ) + Y * ∑ i, (w i : ℝ)) / (2 * (H : ℝ) + 1) ^ Fintype.card ι) * (16 * v / (q : ℝ) + 16 * exp (-v) / eps) := by classical have hv0 : 0 < v := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv have hB : 0 ≤ 16 * v / (q : ℝ) + 16 * exp (-v) / eps := by positivity have hw := (primeLogOddsMark_broad_normalized hlam hlam2 hv heps heps1 hlarge).1 exact (finite_weighted_mul_residues_le _ _ hcop hB hw (fun _ ↦ primeLogOddsMark_broad_residue_upper hlam hlam2 hv heps heps1 hlarge hq) S).trans (mul_le_mul_of_nonneg_right (proper_cube_near_grid_card_le w hproper hY hYH hW hscale hq S hS) hB) end Erdos859Verification end /- Inlined development module: CubePhaseChain.lean -/ section /- Connect the Euclidean phase statistic to the deterministic no-wrap chain. -/ open Finset namespace Erdos859Verification theorem nearInteger_of_cubePhaseSquare_le {ι : Type*} [Fintype ι] (w : ι → ℕ) {Y a : ℝ} (hY : 0 < Y) (hphase : cubePhaseSquare w (a : AddCircle (1 : ℝ)) ≤ 1 / Y ^ 2) (i : ι) : NearInteger (1 / Y) (a * (w i : ℝ)) := by have hi : ‖w i • (a : AddCircle (1 : ℝ))‖ ^ 2 ≤ cubePhaseSquare w (a : AddCircle (1 : ℝ)) := by unfold cubePhaseSquare exact single_le_sum (fun j _ ↦ sq_nonneg ‖w j • (a : AddCircle (1 : ℝ))‖) (mem_univ i) have hsq : ‖w i • (a : AddCircle (1 : ℝ))‖ ^ 2 ≤ (1 / Y) ^ 2 := by simpa only [div_pow, one_pow] using hi.trans hphase have hn := (sq_le_sq₀ (norm_nonneg _) (by positivity : 0 ≤ 1 / Y)).mp hsq rw [← QuotientAddGroup.mk_nsmul, nsmul_eq_mul, UnitAddCircle.norm_eq] at hn refine ⟨round (a * (w i : ℝ)), ?_⟩ simpa only [mul_comm (w i : ℝ) a] using hn /-- A localized nonzero rational phase cannot stay small along a divisor chain that reaches its denominator. The terminal denominator has phase zero and need not be included among the other coins. -/ theorem cubePhase_gap_of_localized_chain {ι : Type*} [Fintype ι] (w : ι → ℕ) {Y : ℝ} {a : ℤ} {r k : ℕ} (v : ℕ → ℕ) (hY : 2 < Y) (ha : a ≠ 0) (hr : 0 < r) (hlast : v k = r) (hcoins : ∀ i ≤ k, v i = r ∨ ∃ j, w j = v i) (hgap : ∀ i < k, (v (i + 1) : ℝ) ≤ Y / 2 * v i) (hlocal : cubePhaseSquare w (((a : ℝ) / r : ℝ) : AddCircle (1 : ℝ)) ≤ 1 / Y ^ 2 → |(a : ℝ) / r| * v 0 ≤ 1 / 2) : 1 / Y ^ 2 < cubePhaseSquare w (((a : ℝ) / r : ℝ) : AddCircle (1 : ℝ)) := by by_contra! hphase have hYpos : 0 < Y := by linarith apply no_nonzero_rational_phase_on_chain hY ha hr (fun i _ ↦ Nat.cast_nonneg (v i)) (by exact_mod_cast hlast) (hlocal hphase) hgap intro i hi rcases hcoins i hi with hterminal | ⟨j, hj⟩ · refine ⟨a, ?_⟩ rw [hterminal, div_mul_cancel₀ _ (by exact_mod_cast Nat.ne_of_gt hr), sub_self, abs_zero] positivity · simpa only [hj] using nearInteger_of_cubePhaseSquare_le w hYpos hphase j end Erdos859Verification end /- Inlined development module: TranslationHoleFilling.lean -/ section /- Lebesgue autocorrelation and quadratic filling of holes by a random shift. -/ open MeasureTheory Real open scoped ENNReal namespace Erdos859Verification /-- Translation by `g`, written as a preimage to make measurability explicit. -/ def realTranslateSet (E : Set ℝ) (g : ℝ) : Set ℝ := (fun x ↦ x - g) ⁻¹' E theorem measurableSet_realTranslateSet {E : Set ℝ} (hE : MeasurableSet E) (g : ℝ) : MeasurableSet (realTranslateSet E g) := hE.preimage (measurable_id.sub measurable_const) noncomputable def translationOverlap (E : Set ℝ) (g : ℝ) : ℝ := volume.real (E ∩ realTranslateSet E g) theorem translationOverlap_nonneg (E : Set ℝ) (g : ℝ) : 0 ≤ translationOverlap E g := measureReal_nonneg theorem translationOverlap_eq_convolution {E : Set ℝ} (hE : MeasurableSet E) : translationOverlap E = convolution (E.indicator (fun _ ↦ (1 : ℝ))) (fun x ↦ E.indicator (fun _ ↦ (1 : ℝ)) (-x)) (ContinuousLinearMap.lsmul ℝ ℝ) volume := by classical funext g have hs := hE.inter (measurableSet_realTranslateSet hE g) rw [translationOverlap, ← integral_indicator_one hs, convolution_def] apply integral_congr_ae filter_upwards [] with x by_cases hx : x ∈ E <;> by_cases hxg : x - g ∈ E <;> simp [realTranslateSet, hx, hxg, neg_sub] /-- The overlap function is integrable for every measurable set of finite measure. -/ theorem integrable_translationOverlap {E : Set ℝ} (hE : MeasurableSet E) (hfinite : volume E ≠ ∞) : Integrable (translationOverlap E) := by have hf : Integrable (E.indicator (fun _ ↦ (1 : ℝ))) := (integrableOn_const (C := (1 : ℝ)) hfinite).integrable_indicator hE rw [translationOverlap_eq_convolution hE] exact hf.integrable_convolution (ContinuousLinearMap.lsmul ℝ ℝ) hf.comp_neg /-- Integrating the autocorrelation gives the square of the missing measure. -/ theorem integral_translationOverlap {E : Set ℝ} (hE : MeasurableSet E) (hfinite : volume E ≠ ∞) : (∫ g : ℝ, translationOverlap E g) = (volume.real E) ^ 2 := by have hf : Integrable (E.indicator (fun _ ↦ (1 : ℝ))) := (integrableOn_const (C := (1 : ℝ)) hfinite).integrable_indicator hE rw [translationOverlap_eq_convolution hE, integral_convolution (ContinuousLinearMap.lsmul ℝ ℝ) hf hf.comp_neg, integral_neg_eq_self] simp only [integral_indicator hE, setIntegral_const, ContinuousLinearMap.lsmul_apply, smul_eq_mul, mul_one, pow_two] /-- Missing points after adjoining one translate to the covered set. -/ noncomputable def remainingHoleMeasure (A I : Set ℝ) (g : ℝ) : ℝ := volume.real (I \ (A ∪ realTranslateSet A g)) theorem remainingHoleMeasure_nonneg (A I : Set ℝ) (g : ℝ) : 0 ≤ remainingHoleMeasure A I g := measureReal_nonneg theorem measurable_remainingHoleMeasure {A I : Set ℝ} (hA : MeasurableSet A) (hI : MeasurableSet I) : Measurable (remainingHoleMeasure A I) := by let S : Set (ℝ × ℝ) := {z | z.2 ∈ I ∧ z.2 ∉ A ∧ z.2 - z.1 ∉ A} have hS : MeasurableSet S := (hI.preimage measurable_snd).inter ((hA.compl.preimage measurable_snd).inter (hA.compl.preimage (measurable_snd.sub measurable_fst))) have heq : remainingHoleMeasure A I = fun g ↦ volume.real (Prod.mk g ⁻¹' S) := by funext g apply congrArg volume.real ext x simp only [S, realTranslateSet, Set.mem_preimage, Set.mem_ofPred_eq, Set.mem_sdiff, Set.mem_union, not_or] rw [heq] exact (measurable_measure_prodMk_left hS).ennreal_toReal /-- A hole surviving a shift in the trimmed interval gives two holes in the original interval. This deterministic inclusion keeps the boundary exact. -/ theorem remainingHoleMeasure_trim_le {A : Set ℝ} {a b w g : ℝ} (hw : 0 ≤ w) (hg : g ∈ Set.Icc (-w) w) : remainingHoleMeasure A (Set.Icc (a + w) (b - w)) g ≤ translationOverlap (Set.Icc a b \ A) g := by apply measureReal_mono · intro x hx obtain ⟨hxI, hxA⟩ := hx have hnotA : x ∉ A := (not_or.mp hxA).1 have hnotAg : x - g ∉ A := (not_or.mp hxA).2 refine ⟨⟨⟨?_, ?_⟩, hnotA⟩, ⟨⟨?_, ?_⟩, hnotAg⟩⟩ all_goals linarith [hxI.1, hxI.2, hg.1, hg.2] · exact measure_ne_top_of_subset (Set.inter_subset_left.trans Set.sdiff_subset) isCompact_Icc.measure_ne_top /-- Quadratic hole filling for a nonnegative shift density supported in `[-w,w]` and bounded by `2 / w`. Both the expectation and its integrability are proved from the density and the measurable covered set. -/ theorem translation_hole_filling {A : Set ℝ} (hA : MeasurableSet A) {a b w : ℝ} (hw : 0 < w) {f : ℝ → ℝ} (hf : Measurable f) (hf0 : ∀ g, 0 ≤ f g) (hfsupp : ∀ g, g ∉ Set.Icc (-w) w → f g = 0) (hfbound : ∀ g, f g ≤ 2 / w) : Integrable (fun g ↦ f g * remainingHoleMeasure A (Set.Icc (a + w) (b - w)) g) ∧ (∫ g : ℝ, f g * remainingHoleMeasure A (Set.Icc (a + w) (b - w)) g) ≤ 2 * (volume.real (Set.Icc a b \ A)) ^ 2 / w := by let E := Set.Icc a b \ A have hE : MeasurableSet E := measurableSet_Icc.diff hA have hfinite : volume E ≠ ∞ := measure_ne_top_of_subset Set.sdiff_subset isCompact_Icc.measure_ne_top have hcoeff : 0 ≤ (2 : ℝ) / w := (div_pos (by norm_num) hw).le have hmajor : ∀ g, f g * remainingHoleMeasure A (Set.Icc (a + w) (b - w)) g ≤ (2 / w) * translationOverlap E g := by intro g by_cases hg : g ∈ Set.Icc (-w) w · exact mul_le_mul (hfbound g) (remainingHoleMeasure_trim_le hw.le hg) (remainingHoleMeasure_nonneg _ _ _) hcoeff · rw [hfsupp g hg, zero_mul] exact mul_nonneg hcoeff (translationOverlap_nonneg E g) have hnonneg : ∀ g, 0 ≤ f g * remainingHoleMeasure A (Set.Icc (a + w) (b - w)) g := fun g ↦ mul_nonneg (hf0 g) (remainingHoleMeasure_nonneg _ _ _) have hupper := (integrable_translationOverlap hE hfinite).const_mul (2 / w) have hlower := hupper.mono_nonneg (hf.mul (measurable_remainingHoleMeasure hA measurableSet_Icc)).aestronglyMeasurable (Filter.Eventually.of_forall hnonneg) (Filter.Eventually.of_forall hmajor) refine ⟨hlower, ?_⟩ calc _ ≤ ∫ g : ℝ, (2 / w) * translationOverlap E g := integral_mono hlower hupper hmajor _ = (2 / w) * (volume.real E) ^ 2 := by rw [integral_const_mul, integral_translationOverlap hE hfinite] _ = _ := by ring noncomputable def translationShiftLaw (f : ℝ → ℝ) : Measure ℝ := volume.withDensity (fun g ↦ ENNReal.ofReal (f g)) theorem translationShiftLaw_isProbability (f : ℝ → ℝ) (hmass : (∫⁻ g : ℝ, ENNReal.ofReal (f g)) = 1) : IsProbabilityMeasure (translationShiftLaw f) := by constructor rw [translationShiftLaw, withDensity_apply _ MeasurableSet.univ, Measure.restrict_univ] exact hmass /-- The same estimate as an expectation under the shift's density measure. -/ theorem translation_hole_filling_withDensity {A : Set ℝ} (hA : MeasurableSet A) {a b w : ℝ} (hw : 0 < w) {f : ℝ → ℝ} (hf : Measurable f) (hf0 : ∀ g, 0 ≤ f g) (hfsupp : ∀ g, g ∉ Set.Icc (-w) w → f g = 0) (hfbound : ∀ g, f g ≤ 2 / w) : Integrable (remainingHoleMeasure A (Set.Icc (a + w) (b - w))) (translationShiftLaw f) ∧ (∫ g : ℝ, remainingHoleMeasure A (Set.Icc (a + w) (b - w)) g ∂ translationShiftLaw f) ≤ 2 * (volume.real (Set.Icc a b \ A)) ^ 2 / w := by have hmain := translation_hole_filling hA hw hf hf0 hfsupp hfbound (a := a) (b := b) have hfinite : ∀ᵐ g : ℝ ∂ volume, ENNReal.ofReal (f g) < ∞ := Filter.Eventually.of_forall (fun g ↦ ENNReal.ofReal_lt_top) have hreal : ∀ g, (ENNReal.ofReal (f g)).toReal = f g := fun g ↦ ENNReal.toReal_ofReal (hf0 g) constructor · rw [translationShiftLaw, integrable_withDensity_iff hf.ennreal_ofReal hfinite] simpa only [hreal, mul_comm] using hmain.1 · rw [translationShiftLaw, integral_withDensity_eq_integral_toReal_smul hf.ennreal_ofReal hfinite] simpa only [hreal, smul_eq_mul] using hmain.2 /-- Markov's inequality for the actual shifted-hole random variable. -/ theorem translation_hole_filling_tail_bound {A : Set ℝ} (hA : MeasurableSet A) {a b w : ℝ} (hw : 0 < w) {f : ℝ → ℝ} (hf : Measurable f) (hf0 : ∀ g, 0 ≤ f g) (hfsupp : ∀ g, g ∉ Set.Icc (-w) w → f g = 0) (hfbound : ∀ g, f g ≤ 2 / w) {r : ℝ} (hr : 0 < r) : (translationShiftLaw f).real {g | r ≤ remainingHoleMeasure A (Set.Icc (a + w) (b - w)) g} ≤ (2 * (volume.real (Set.Icc a b \ A)) ^ 2 / w) / r := by have hmain := translation_hole_filling_withDensity hA hw hf hf0 hfsupp hfbound (a := a) (b := b) have hmarkov := mul_meas_ge_le_integral_of_nonneg (Filter.Eventually.of_forall (remainingHoleMeasure_nonneg A (Set.Icc (a + w) (b - w)))) hmain.1 r apply (le_div_iff₀ hr).mpr simpa only [mul_comm] using hmarkov.trans hmain.2 end Erdos859Verification end /- Inlined development module: TranslationHoleIteration.lean -/ section /- Successful translations and the doubly exponential quadratic-hole recurrence. -/ open MeasureTheory Real open scoped ENNReal namespace Erdos859Verification /-- The exact exponent retained by the quadratic recurrence. -/ def quadraticHoleExponent (n : ℕ) : ℕ := 3 * 2 ^ n + n + 7 theorem quadraticHole_step_identity (n : ℕ) : (2 : ℝ) ^ (n + 6) * (1 / (2 : ℝ) ^ quadraticHoleExponent n) ^ 2 = 1 / (2 : ℝ) ^ quadraticHoleExponent (n + 1) := by have he : quadraticHoleExponent (n + 1) + (n + 6) = quadraticHoleExponent n * 2 := by simp only [quadraticHoleExponent, pow_succ] omega have hp : (2 : ℝ) ^ quadraticHoleExponent (n + 1) * (2 : ℝ) ^ (n + 6) = ((2 : ℝ) ^ quadraticHoleExponent n) ^ 2 := by rw [← pow_add, he, pow_mul] have hpos : 0 < (2 : ℝ) ^ quadraticHoleExponent n := by positivity have hpos' : 0 < (2 : ℝ) ^ quadraticHoleExponent (n + 1) := by positivity field_simp nlinarith /-- A stronger closed bound includes the unused linear part of the exponent. -/ theorem quadraticHole_recurrence_strong {e : ℕ → ℝ} (he : ∀ n, 0 ≤ e n) (hzero : e 0 ≤ 1 / (2 : ℝ) ^ 10) (hstep : ∀ n, e (n + 1) ≤ (2 : ℝ) ^ (n + 6) * (e n) ^ 2) : ∀ n, e n ≤ 1 / (2 : ℝ) ^ quadraticHoleExponent n := by intro n induction n with | zero => simpa only [quadraticHoleExponent, pow_zero, Nat.mul_one, Nat.add_zero] using hzero | succ n ih => calc e (n + 1) ≤ (2 : ℝ) ^ (n + 6) * (e n) ^ 2 := hstep n _ ≤ (2 : ℝ) ^ (n + 6) * (1 / (2 : ℝ) ^ quadraticHoleExponent n) ^ 2 := mul_le_mul_of_nonneg_left (pow_le_pow_left₀ (he n) ih 2) (by positivity) _ = _ := quadraticHole_step_identity n /-- The manuscript's normalized holes decrease doubly exponentially. -/ theorem quadraticHole_recurrence {e : ℕ → ℝ} (he : ∀ n, 0 ≤ e n) (hzero : e 0 ≤ 1 / (2 : ℝ) ^ 10) (hstep : ∀ n, e (n + 1) ≤ (2 : ℝ) ^ (n + 6) * (e n) ^ 2) : ∀ n, e n ≤ 1 / (2 : ℝ) ^ (3 * 2 ^ n) := by intro n apply (quadraticHole_recurrence_strong he hzero hstep n).trans exact one_div_le_one_div_of_le (by positivity) (pow_le_pow_right₀ (by norm_num) (by dsimp [quadraticHoleExponent]; omega)) theorem translationShiftLaw_outside_support {f : ℝ → ℝ} {w : ℝ} (hfsupp : ∀ g, g ∉ Set.Icc (-w) w → f g = 0) : translationShiftLaw f (Set.Icc (-w) w)ᶜ = 0 := by rw [translationShiftLaw, withDensity_apply _ measurableSet_Icc.compl] apply setLIntegral_eq_zero measurableSet_Icc.compl intro g hg simp only [hfsupp g hg, ENNReal.ofReal_zero, Pi.zero_apply] /-- First-moment selection supplies a shift in the allowed interval, including when the original missing measure is zero. The factor two is stronger than the factor four needed in the recurrence. -/ theorem exists_successful_hole_shift {A : Set ℝ} (hA : MeasurableSet A) {a b w : ℝ} (hw : 0 < w) {f : ℝ → ℝ} (hf : Measurable f) (hf0 : ∀ g, 0 ≤ f g) (hfsupp : ∀ g, g ∉ Set.Icc (-w) w → f g = 0) (hfbound : ∀ g, f g ≤ 2 / w) (hmass : (∫⁻ g : ℝ, ENNReal.ofReal (f g)) = 1) : ∃ g ∈ Set.Icc (-w) w, remainingHoleMeasure A (Set.Icc (a + w) (b - w)) g ≤ 2 * (volume.real (Set.Icc a b \ A)) ^ 2 / w := by let : IsProbabilityMeasure (translationShiftLaw f) := translationShiftLaw_isProbability f hmass have hmain := translation_hole_filling_withDensity hA hw hf hf0 hfsupp hfbound (a := a) (b := b) obtain ⟨g, hg, hgood⟩ := exists_notMem_null_le_integral hmain.1 (translationShiftLaw_outside_support hfsupp) exact ⟨g, by simpa only [Set.mem_compl_iff, not_not] using hg, hgood.trans hmain.2⟩ theorem exists_successful_hole_shift_four {A : Set ℝ} (hA : MeasurableSet A) {a b w : ℝ} (hw : 0 < w) {f : ℝ → ℝ} (hf : Measurable f) (hf0 : ∀ g, 0 ≤ f g) (hfsupp : ∀ g, g ∉ Set.Icc (-w) w → f g = 0) (hfbound : ∀ g, f g ≤ 2 / w) (hmass : (∫⁻ g : ℝ, ENNReal.ofReal (f g)) = 1) : ∃ g ∈ Set.Icc (-w) w, remainingHoleMeasure A (Set.Icc (a + w) (b - w)) g ≤ 4 * (volume.real (Set.Icc a b \ A)) ^ 2 / w := by obtain ⟨g, hg, hgood⟩ := exists_successful_hole_shift hA hw hf hf0 hfsupp hfbound hmass (a := a) (b := b) refine ⟨g, hg, hgood.trans ?_⟩ apply div_le_div_of_nonneg_right _ hw.le nlinarith [sq_nonneg (volume.real (Set.Icc a b \ A))] /-- Width at the transition from step `n` to step `n + 1`; the manuscript labels this transition by `i = n + 1`. -/ noncomputable def quadraticHoleWidth (ell : ℝ) (n : ℕ) : ℝ := ell / (2 : ℝ) ^ (n + 4) theorem quadraticHoleWidth_pos {ell : ℝ} (hell : 0 < ell) (n : ℕ) : 0 < quadraticHoleWidth ell n := by unfold quadraticHoleWidth positivity /-- Dividing physical missing measure by `ell` gives exactly the coefficient used in the normalized quadratic recurrence. -/ theorem quadraticHole_step_normalize {ell b b' : ℝ} (hell : 0 < ell) (n : ℕ) (hstep : b' ≤ 4 * b ^ 2 / quadraticHoleWidth ell n) : b' / ell ≤ (2 : ℝ) ^ (n + 6) * (b / ell) ^ 2 := by apply (div_le_div_of_nonneg_right hstep hell.le).trans_eq rw [quadraticHoleWidth, show n + 6 = (n + 4) + 2 by omega, pow_add] norm_num field_simp simp only [pow_add] norm_num ring /-- The same doubly exponential estimate for physical missing measures. -/ theorem quadraticHole_actual_recurrence {ell : ℝ} (hell : 0 < ell) {b : ℕ → ℝ} (hb : ∀ n, 0 ≤ b n) (hzero : b 0 ≤ ell / (2 : ℝ) ^ 10) (hstep : ∀ n, b (n + 1) ≤ 4 * (b n) ^ 2 / quadraticHoleWidth ell n) : ∀ n, b n ≤ ell / (2 : ℝ) ^ (3 * 2 ^ n) := by have hzero' : b 0 / ell ≤ 1 / (2 : ℝ) ^ 10 := by apply (div_le_iff₀ hell).mpr simpa only [div_eq_mul_inv, one_mul, mul_comm] using hzero have hnormalized := quadraticHole_recurrence (fun n ↦ div_nonneg (hb n) hell.le) hzero' (fun n ↦ quadraticHole_step_normalize hell n (hstep n)) intro n have hn := (div_le_iff₀ hell).mp (hnormalized n) simpa only [div_eq_mul_inv, one_mul, mul_comm] using hn noncomputable def quadraticHoleTrim (ell : ℝ) (n : ℕ) : ℝ := ∑ i ∈ Finset.range n, quadraticHoleWidth ell i theorem quadraticHoleTrim_zero (ell : ℝ) : quadraticHoleTrim ell 0 = 0 := by simp only [quadraticHoleTrim, Finset.range_zero, Finset.sum_empty] theorem quadraticHoleTrim_succ (ell : ℝ) (n : ℕ) : quadraticHoleTrim ell (n + 1) = quadraticHoleTrim ell n + quadraticHoleWidth ell n := Finset.sum_range_succ _ n /-- A certificate retaining the actual finite sequence of union-with-translate steps. -/ inductive QuadraticHoleRefinement (ell : ℝ) (A : Set ℝ) : ℕ → Set ℝ → Prop where | initial : QuadraticHoleRefinement ell A 0 A | step {n : ℕ} {S : Set ℝ} (hprev : QuadraticHoleRefinement ell A n S) (g : ℝ) (hg : g ∈ Set.Icc (-quadraticHoleWidth ell n) (quadraticHoleWidth ell n)) : QuadraticHoleRefinement ell A (n + 1) (S ∪ realTranslateSet S g) /-- Any finite number of refinement steps can be realized by allowed shifts. The statement retains the generated covered set and the exact trimmed interval. -/ theorem exists_finite_quadratic_hole_refinement {ell : ℝ} (hell : 0 < ell) {A : Set ℝ} (hA : MeasurableSet A) {a b : ℝ} (hstart : volume.real (Set.Icc a b \ A) ≤ ell / (2 : ℝ) ^ 10) (f : ℕ → ℝ → ℝ) (hf : ∀ n, Measurable (f n)) (hf0 : ∀ n g, 0 ≤ f n g) (hfsupp : ∀ n g, g ∉ Set.Icc (-quadraticHoleWidth ell n) (quadraticHoleWidth ell n) → f n g = 0) (hfbound : ∀ n g, f n g ≤ 2 / quadraticHoleWidth ell n) (hmass : ∀ n, (∫⁻ g : ℝ, ENNReal.ofReal (f n g)) = 1) : ∀ n : ℕ, ∃ S : Set ℝ, MeasurableSet S ∧ QuadraticHoleRefinement ell A n S ∧ volume.real (Set.Icc (a + quadraticHoleTrim ell n) (b - quadraticHoleTrim ell n) \ S) ≤ ell / (2 : ℝ) ^ quadraticHoleExponent n := by intro n induction n with | zero => refine ⟨A, hA, QuadraticHoleRefinement.initial, ?_⟩ simpa only [quadraticHoleTrim_zero, add_zero, sub_zero, quadraticHoleExponent, pow_zero, Nat.mul_one, Nat.add_zero] using hstart | succ n ih => obtain ⟨S, hS, hpath, hholes⟩ := ih obtain ⟨g, hg, hnew⟩ := exists_successful_hole_shift_four hS (quadraticHoleWidth_pos hell n) (hf n) (hf0 n) (hfsupp n) (hfbound n) (hmass n) (a := a + quadraticHoleTrim ell n) (b := b - quadraticHoleTrim ell n) refine ⟨S ∪ realTranslateSet S g, hS.union (measurableSet_realTranslateSet hS g), QuadraticHoleRefinement.step hpath g hg, ?_⟩ have hold : volume.real (Set.Icc (a + quadraticHoleTrim ell n) (b - quadraticHoleTrim ell n) \ S) / ell ≤ 1 / (2 : ℝ) ^ quadraticHoleExponent n := by apply (div_le_iff₀ hell).mpr simpa only [div_eq_mul_inv, one_mul, mul_comm] using hholes have hnewnorm := quadraticHole_step_normalize hell n hnew have hbound : remainingHoleMeasure S (Set.Icc ((a + quadraticHoleTrim ell n) + quadraticHoleWidth ell n) ((b - quadraticHoleTrim ell n) - quadraticHoleWidth ell n)) g / ell ≤ 1 / (2 : ℝ) ^ quadraticHoleExponent (n + 1) := by apply hnewnorm.trans calc _ ≤ (2 : ℝ) ^ (n + 6) * (1 / (2 : ℝ) ^ quadraticHoleExponent n) ^ 2 := mul_le_mul_of_nonneg_left (pow_le_pow_left₀ (div_nonneg measureReal_nonneg hell.le) hold 2) (by positivity) _ = _ := quadraticHole_step_identity n have hphysical := (div_le_iff₀ hell).mp hbound have haeq : a + quadraticHoleTrim ell (n + 1) = (a + quadraticHoleTrim ell n) + quadraticHoleWidth ell n := by rw [quadraticHoleTrim_succ] ring have hbeq : b - quadraticHoleTrim ell (n + 1) = (b - quadraticHoleTrim ell n) - quadraticHoleWidth ell n := by rw [quadraticHoleTrim_succ] ring rw [haeq, hbeq] simpa only [remainingHoleMeasure, div_eq_mul_inv, one_mul, mul_comm] using hphysical end Erdos859Verification end /- Inlined development module: TranslationInitialCoverage.lean -/ section /- Initial coverage by translations with a uniformly positive density. -/ open MeasureTheory Real open scoped ENNReal namespace Erdos859Verification noncomputable def crossTranslationOverlap (E B : Set ℝ) (g : ℝ) : ℝ := volume.real (E ∩ realTranslateSet B g) theorem measurable_crossTranslationOverlap {E B : Set ℝ} (hE : MeasurableSet E) (hB : MeasurableSet B) : Measurable (crossTranslationOverlap E B) := by let S : Set (ℝ × ℝ) := {z | z.2 ∈ E ∧ z.2 - z.1 ∈ B} have hS : MeasurableSet S := (hE.preimage measurable_snd).inter (hB.preimage (measurable_snd.sub measurable_fst)) have heq : crossTranslationOverlap E B = fun g ↦ volume.real (Prod.mk g ⁻¹' S) := rfl rw [heq] exact (measurable_measure_prodMk_left hS).ennreal_toReal theorem crossTranslationOverlap_eq_convolution {E B : Set ℝ} (hE : MeasurableSet E) (hB : MeasurableSet B) : crossTranslationOverlap E B = convolution (E.indicator (fun _ ↦ (1 : ℝ))) (fun x ↦ B.indicator (fun _ ↦ (1 : ℝ)) (-x)) (ContinuousLinearMap.lsmul ℝ ℝ) volume := by classical funext g have hs := hE.inter (measurableSet_realTranslateSet hB g) rw [crossTranslationOverlap, ← integral_indicator_one hs, convolution_def] apply integral_congr_ae filter_upwards [] with x by_cases hx : x ∈ E <;> by_cases hxg : x - g ∈ B <;> simp [realTranslateSet, hx, hxg, neg_sub] theorem integrable_crossTranslationOverlap {E B : Set ℝ} (hE : MeasurableSet E) (hB : MeasurableSet B) (hEfin : volume E ≠ ∞) (hBfin : volume B ≠ ∞) : Integrable (crossTranslationOverlap E B) := by have he : Integrable (E.indicator (fun _ ↦ (1 : ℝ))) := (integrableOn_const (C := (1 : ℝ)) hEfin).integrable_indicator hE have hb : Integrable (B.indicator (fun _ ↦ (1 : ℝ))) := (integrableOn_const (C := (1 : ℝ)) hBfin).integrable_indicator hB rw [crossTranslationOverlap_eq_convolution hE hB] exact he.integrable_convolution (ContinuousLinearMap.lsmul ℝ ℝ) hb.comp_neg theorem integral_crossTranslationOverlap {E B : Set ℝ} (hE : MeasurableSet E) (hB : MeasurableSet B) (hEfin : volume E ≠ ∞) (hBfin : volume B ≠ ∞) : (∫ g : ℝ, crossTranslationOverlap E B g) = volume.real E * volume.real B := by have he : Integrable (E.indicator (fun _ ↦ (1 : ℝ))) := (integrableOn_const (C := (1 : ℝ)) hEfin).integrable_indicator hE have hb : Integrable (B.indicator (fun _ ↦ (1 : ℝ))) := (integrableOn_const (C := (1 : ℝ)) hBfin).integrable_indicator hB rw [crossTranslationOverlap_eq_convolution hE hB, integral_convolution (ContinuousLinearMap.lsmul ℝ ℝ) he hb.comp_neg, integral_neg_eq_self] simp only [integral_indicator hE, integral_indicator hB, setIntegral_const, ContinuousLinearMap.lsmul_apply, smul_eq_mul, mul_one] theorem crossTranslationOverlap_le {E B : Set ℝ} (hEfin : volume E ≠ ∞) (g : ℝ) : crossTranslationOverlap E B g ≤ volume.real E := measureReal_mono Set.inter_subset_left hEfin theorem crossTranslationOverlap_zero_outside {E B : Set ℝ} {L g : ℝ} (hEI : E ⊆ Set.Icc 0 L) (hBI : B ⊆ Set.Icc 0 L) (hg : g ∉ Set.Icc (-L) L) : crossTranslationOverlap E B g = 0 := by have hs : E ∩ realTranslateSet B g = ∅ := by apply Set.eq_empty_iff_forall_notMem.mpr intro x hx have hxE := hEI hx.1 have hxB := hBI hx.2 apply hg constructor <;> linarith [hxE.1, hxE.2, hxB.1, hxB.2] simp only [crossTranslationOverlap, hs, measureReal_empty] theorem missing_after_translate_eq {E B : Set ℝ} (hE : MeasurableSet E) (hB : MeasurableSet B) (hEfin : volume E ≠ ∞) (g : ℝ) : volume.real (E \ realTranslateSet B g) = volume.real E - crossTranslationOverlap E B g := by have hs : E \ realTranslateSet B g = E \ (E ∩ realTranslateSet B g) := by ext x simp only [Set.mem_sdiff, Set.mem_inter_iff] tauto rw [hs] exact measureReal_sdiff Set.inter_subset_left (hE.inter (measurableSet_realTranslateSet hB g)) hEfin /-- Exact contraction of missing measure. No independence or expectation bound is assumed: the estimate follows from the density lower bound and the cross-correlation integral. -/ theorem initialCoverage_expectation_contraction {E B : Set ℝ} (hE : MeasurableSet E) (hB : MeasurableSet B) {L c : ℝ} (hEI : E ⊆ Set.Icc 0 L) (hBI : B ⊆ Set.Icc 0 L) {f : ℝ → ℝ} (hf : Measurable f) (hf0 : ∀ g, 0 ≤ f g) (hflower : ∀ g ∈ Set.Icc (-L) L, c / L ≤ f g) (hmass : (∫⁻ g : ℝ, ENNReal.ofReal (f g)) = 1) : Integrable (fun g ↦ volume.real (E \ realTranslateSet B g)) (translationShiftLaw f) ∧ (∫ g : ℝ, volume.real (E \ realTranslateSet B g) ∂ translationShiftLaw f) ≤ (1 - c * volume.real B / L) * volume.real E := by let : IsProbabilityMeasure (translationShiftLaw f) := translationShiftLaw_isProbability f hmass have hEfin : volume E ≠ ∞ := measure_ne_top_of_subset hEI isCompact_Icc.measure_ne_top have hBfin : volume B ≠ ∞ := measure_ne_top_of_subset hBI isCompact_Icc.measure_ne_top have hmeas := measurable_crossTranslationOverlap hE hB have hcross : Integrable (crossTranslationOverlap E B) (translationShiftLaw f) := (integrable_const (volume.real E)).mono_nonneg hmeas.aestronglyMeasurable (Filter.Eventually.of_forall (fun _ ↦ measureReal_nonneg)) (Filter.Eventually.of_forall (crossTranslationOverlap_le hEfin)) have hfinite : ∀ᵐ g : ℝ ∂ volume, ENNReal.ofReal (f g) < ∞ := Filter.Eventually.of_forall (fun _ ↦ ENNReal.ofReal_lt_top) have hreal : ∀ g, (ENNReal.ofReal (f g)).toReal = f g := fun g ↦ ENNReal.toReal_ofReal (hf0 g) have hweighted : Integrable (fun g ↦ f g * crossTranslationOverlap E B g) := by have h := (integrable_withDensity_iff hf.ennreal_ofReal hfinite).mp hcross simpa only [hreal, mul_comm] using h have hlow : (c / L) * (volume.real E * volume.real B) ≤ ∫ g : ℝ, crossTranslationOverlap E B g ∂ translationShiftLaw f := by rw [translationShiftLaw, integral_withDensity_eq_integral_toReal_smul hf.ennreal_ofReal hfinite] simp only [hreal, smul_eq_mul] calc _ = ∫ g : ℝ, (c / L) * crossTranslationOverlap E B g := by rw [integral_const_mul, integral_crossTranslationOverlap hE hB hEfin hBfin] _ ≤ _ := by apply integral_mono ((integrable_crossTranslationOverlap hE hB hEfin hBfin).const_mul _) hweighted intro g change (c / L) * crossTranslationOverlap E B g ≤ f g * crossTranslationOverlap E B g by_cases hg : g ∈ Set.Icc (-L) L · exact mul_le_mul_of_nonneg_right (hflower g hg) measureReal_nonneg · rw [crossTranslationOverlap_zero_outside hEI hBI hg] simp only [mul_zero, le_refl] have hconst : Integrable (fun _ : ℝ ↦ volume.real E) (translationShiftLaw f) := integrable_const _ have heq : (fun g ↦ volume.real (E \ realTranslateSet B g)) = fun g ↦ volume.real E - crossTranslationOverlap E B g := funext (missing_after_translate_eq hE hB hEfin) rw [heq] refine ⟨hconst.sub hcross, ?_⟩ rw [integral_sub hconst hcross, integral_const, probReal_univ, one_smul] calc _ ≤ volume.real E - (c / L) * (volume.real E * volume.real B) := sub_le_sub_left hlow _ _ = _ := by ring theorem exists_initialCoverage_shift {E B : Set ℝ} (hE : MeasurableSet E) (hB : MeasurableSet B) {L c rho : ℝ} (hEI : E ⊆ Set.Icc 0 L) (hBI : B ⊆ Set.Icc 0 L) (hL : 0 < L) (hc : 0 < c) (hrho : 0 < rho) (hBvol : rho * L ≤ volume.real B) {f : ℝ → ℝ} (hf : Measurable f) (hf0 : ∀ g, 0 ≤ f g) (hflower : ∀ g ∈ Set.Icc (-L) L, c / L ≤ f g) (hmass : (∫⁻ g : ℝ, ENNReal.ofReal (f g)) = 1) : ∃ g ∈ Set.Icc (-L) L, volume.real (E \ realTranslateSet B g) ≤ (1 - c * rho) * volume.real E := by let : IsProbabilityMeasure (translationShiftLaw f) := translationShiftLaw_isProbability f hmass have hEfin : volume E ≠ ∞ := measure_ne_top_of_subset hEI isCompact_Icc.measure_ne_top by_cases hzero : volume.real E = 0 · refine ⟨0, ⟨by linarith, hL.le⟩, ?_⟩ have hle := measureReal_mono (Set.sdiff_subset (s := E) (t := realTranslateSet B 0)) hEfin simpa only [hzero, mul_zero] using hle have hEpos : 0 < volume.real E := lt_of_le_of_ne measureReal_nonneg (Ne.symm hzero) have hmain := initialCoverage_expectation_contraction hE hB hEI hBI hf hf0 hflower hmass obtain ⟨g, hg⟩ := exists_le_integral hmain.1 have hprob : c * rho ≤ c * volume.real B / L := by apply (le_div_iff₀ hL).mpr nlinarith [mul_le_mul_of_nonneg_left hBvol hc.le] have hgood : volume.real (E \ realTranslateSet B g) ≤ (1 - c * rho) * volume.real E := (hg.trans hmain.2).trans (mul_le_mul_of_nonneg_right (sub_le_sub_left hprob 1) measureReal_nonneg) refine ⟨g, ?_, hgood⟩ by_contra hout have heq := missing_after_translate_eq hE hB hEfin g rw [crossTranslationOverlap_zero_outside hEI hBI hout, sub_zero] at heq rw [heq] at hgood have hpos := mul_pos (mul_pos hc hrho) hEpos nlinarith /-- A finite list of translations of the same base set, retaining every translation's allowed range. -/ inductive InitialCoverageByTranslates (L : ℝ) (B : Set ℝ) : ℕ → Set ℝ → Prop where | initial : InitialCoverageByTranslates L B 0 B | step {n : ℕ} {A : Set ℝ} (hprev : InitialCoverageByTranslates L B n A) (g : ℝ) (hg : g ∈ Set.Icc (-L) L) : InitialCoverageByTranslates L B (n + 1) (A ∪ realTranslateSet B g) theorem InitialCoverageByTranslates.base_subset {L : ℝ} {B A : Set ℝ} {n : ℕ} (h : InitialCoverageByTranslates L B n A) : B ⊆ A := by induction h with | initial => exact Set.Subset.rfl | step _ _ _ ih => exact ih.trans Set.subset_union_left /-- Finite initial coverage with its exact geometric error bound. -/ theorem exists_initialCoverage_finite {L c rho : ℝ} (hL : 0 < L) (hc : 0 < c) (hrho : 0 < rho) (hprod : c * rho < 1) {B : Set ℝ} (hB : MeasurableSet B) (hBI : B ⊆ Set.Icc 0 L) (hBvol : rho * L ≤ volume.real B) {f : ℝ → ℝ} (hf : Measurable f) (hf0 : ∀ g, 0 ≤ f g) (hflower : ∀ g ∈ Set.Icc (-L) L, c / L ≤ f g) (hmass : (∫⁻ g : ℝ, ENNReal.ofReal (f g)) = 1) : ∀ n : ℕ, ∃ A : Set ℝ, MeasurableSet A ∧ InitialCoverageByTranslates L B n A ∧ volume.real (Set.Icc 0 L \ A) ≤ (1 - c * rho) ^ n * L := by intro n induction n with | zero => refine ⟨B, hB, InitialCoverageByTranslates.initial, ?_⟩ have hle := measureReal_mono (μ := volume) (Set.sdiff_subset (s := Set.Icc 0 L) (t := B)) isCompact_Icc.measure_ne_top simpa only [volume_real_Icc_of_le hL.le, sub_zero, pow_zero, one_mul] using hle | succ n ih => obtain ⟨A, hA, hpath, hholes⟩ := ih obtain ⟨g, hg, hnew⟩ := exists_initialCoverage_shift (measurableSet_Icc.diff hA) hB Set.sdiff_subset hBI hL hc hrho hBvol hf hf0 hflower hmass refine ⟨A ∪ realTranslateSet B g, hA.union (measurableSet_realTranslateSet hB g), InitialCoverageByTranslates.step hpath g hg, ?_⟩ have heq : Set.Icc 0 L \ (A ∪ realTranslateSet B g) = (Set.Icc 0 L \ A) \ realTranslateSet B g := by ext x simp only [Set.mem_sdiff, Set.mem_union, not_or] tauto rw [heq] calc _ ≤ (1 - c * rho) * volume.real (Set.Icc 0 L \ A) := hnew _ ≤ (1 - c * rho) * ((1 - c * rho) ^ n * L) := mul_le_mul_of_nonneg_left hholes (by linarith) _ = _ := by rw [pow_succ]; ring /-- A number of initial translates depending only on `c` and `rho` leaves at most `2^-10` of the interval uncovered, uniformly in its length and base set. -/ theorem exists_uniform_initialCoverage_steps {c rho : ℝ} (hc : 0 < c) (hrho : 0 < rho) (hprod : c * rho < 1) : ∃ n : ℕ, ∀ L : ℝ, 0 < L → ∀ B : Set ℝ, MeasurableSet B → B ⊆ Set.Icc 0 L → rho * L ≤ volume.real B → ∀ f : ℝ → ℝ, Measurable f → (∀ g, 0 ≤ f g) → (∀ g ∈ Set.Icc (-L) L, c / L ≤ f g) → (∫⁻ g : ℝ, ENNReal.ofReal (f g)) = 1 → ∃ A : Set ℝ, MeasurableSet A ∧ InitialCoverageByTranslates L B n A ∧ volume.real (Set.Icc 0 L \ A) ≤ L / (2 : ℝ) ^ 10 := by obtain ⟨n, hn⟩ := exists_pow_lt_of_lt_one (by positivity : (0 : ℝ) < 1 / (2 : ℝ) ^ 10) (by nlinarith [mul_pos hc hrho] : 1 - c * rho < 1) refine ⟨n, ?_⟩ intro L hL B hB hBI hBvol f hf hf0 hflower hmass obtain ⟨A, hA, hpath, hholes⟩ := exists_initialCoverage_finite hL hc hrho hprod hB hBI hBvol hf hf0 hflower hmass n refine ⟨A, hA, hpath, hholes.trans ?_⟩ simpa only [div_eq_mul_inv, one_mul, mul_comm] using mul_le_mul_of_nonneg_right hn.le hL.le /-- Each point of the interval is hit with the probability predicted by the base-set measure and the density lower bound. -/ theorem initialCoverage_point_probability {B : Set ℝ} (hB : MeasurableSet B) {L c x : ℝ} (hBI : B ⊆ Set.Icc 0 L) (hx : x ∈ Set.Icc 0 L) {f : ℝ → ℝ} (hf : Measurable f) (hf0 : ∀ g, 0 ≤ f g) (hflower : ∀ g ∈ Set.Icc (-L) L, c / L ≤ f g) (hmass : (∫⁻ g : ℝ, ENNReal.ofReal (f g)) = 1) : c * volume.real B / L ≤ (translationShiftLaw f).real {g | x ∈ realTranslateSet B g} := by classical let : IsProbabilityMeasure (translationShiftLaw f) := translationShiftLaw_isProbability f hmass let H : Set ℝ := {g | x ∈ realTranslateSet B g} have hH : MeasurableSet H := hB.preimage (measurable_const.sub measurable_id) have hHI : H ⊆ Set.Icc (-L) L := by intro g hg have hb := hBI hg constructor <;> linarith [hx.1, hx.2, hb.1, hb.2] have hHfin : volume H ≠ ∞ := measure_ne_top_of_subset hHI isCompact_Icc.measure_ne_top have hi : Integrable (H.indicator (fun _ ↦ (1 : ℝ))) := (integrableOn_const (C := (1 : ℝ)) hHfin).integrable_indicator hH have hiLaw : Integrable (H.indicator (fun _ ↦ (1 : ℝ))) (translationShiftLaw f) := (integrable_const _).indicator hH have hfinite : ∀ᵐ g : ℝ ∂ volume, ENNReal.ofReal (f g) < ∞ := Filter.Eventually.of_forall (fun _ ↦ ENNReal.ofReal_lt_top) have hreal : ∀ g, (ENNReal.ofReal (f g)).toReal = f g := fun g ↦ ENNReal.toReal_ofReal (hf0 g) have hweighted : Integrable (fun g ↦ f g * H.indicator (fun _ ↦ (1 : ℝ)) g) := by have h := (integrable_withDensity_iff hf.ennreal_ofReal hfinite).mp hiLaw simpa only [hreal, mul_comm] using h have heq : H.indicator (fun _ ↦ (1 : ℝ)) = fun g ↦ B.indicator (fun _ ↦ (1 : ℝ)) (x - g) := by funext g by_cases hg : x - g ∈ B <;> simp [H, realTranslateSet, hg] have hIntegral : (∫ g : ℝ, H.indicator (fun _ ↦ (1 : ℝ)) g) = volume.real B := by rw [heq, integral_sub_left_eq_self] simpa only [smul_eq_mul, mul_one] using integral_indicator_const (μ := volume) (1 : ℝ) hB have hIntegralLaw : (∫ g : ℝ, f g * H.indicator (fun _ ↦ (1 : ℝ)) g) = (translationShiftLaw f).real H := by have h := integral_withDensity_eq_integral_toReal_smul hf.ennreal_ofReal hfinite (H.indicator (fun _ ↦ (1 : ℝ))) simp only [hreal, smul_eq_mul] at h rw [← h] simpa only [translationShiftLaw, smul_eq_mul, mul_one] using integral_indicator_const (μ := translationShiftLaw f) (1 : ℝ) hH calc _ = (c / L) * volume.real B := by ring _ = ∫ g : ℝ, (c / L) * H.indicator (fun _ ↦ (1 : ℝ)) g := by rw [integral_const_mul, hIntegral] _ ≤ ∫ g : ℝ, f g * H.indicator (fun _ ↦ (1 : ℝ)) g := by apply integral_mono (hi.const_mul _) hweighted intro g change (c / L) * H.indicator (fun _ ↦ (1 : ℝ)) g ≤ f g * H.indicator (fun _ ↦ (1 : ℝ)) g by_cases hg : g ∈ H · simpa only [Set.indicator_of_mem hg, mul_one] using hflower g (hHI hg) · simp only [Set.indicator_of_notMem hg, mul_zero, le_refl] _ = _ := hIntegralLaw end Erdos859Verification end /- Inlined development module: LogUniformPairDensity.lean -/ section /- Concrete logarithmic mark densities and their pair-difference laws. -/ open MeasureTheory Real open scoped ENNReal namespace Erdos859Verification noncomputable def logUniformDensity (u w v : ℝ) : ℝ := (Set.Icc u (u + w)).indicator (fun v ↦ 1 / (v * log (1 + w / u))) v theorem measurable_logUniformDensity (u w : ℝ) : Measurable (logUniformDensity u w) := by unfold logUniformDensity exact (measurable_const.div (measurable_id.mul measurable_const)).indicator measurableSet_Icc theorem logUniform_log_bounds {u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) : 0 < log (1 + w / u) ∧ w / (u + w) ≤ log (1 + w / u) ∧ log (1 + w / u) ≤ w / u := by have hu : 0 < u := hw.trans_le hwu have hr : 0 < w / u := div_pos hw hu have harg : 0 < 1 + w / u := by linarith refine ⟨log_pos (by linarith), ?_, ?_⟩ · have h := one_sub_inv_le_log_of_pos harg have heq : 1 - (1 + w / u)⁻¹ = w / (u + w) := by field_simp ring rwa [heq] at h · have h := log_le_sub_one_of_pos harg linarith theorem logUniformDensity_bounds {u w v : ℝ} (hw : 0 < w) (hwu : w ≤ u) (hv : v ∈ Set.Icc u (u + w)) : 1 / (2 * w) ≤ logUniformDensity u w v ∧ logUniformDensity u w v ≤ 2 / w := by have hu : 0 < u := hw.trans_le hwu obtain ⟨hlog, hlo, hhi⟩ := logUniform_log_bounds hw hwu have hden : 0 < v * log (1 + w / u) := mul_pos (hu.trans_le hv.1) hlog have hdenhi : v * log (1 + w / u) ≤ 2 * w := by have h := (le_div_iff₀ hu).mp hhi nlinarith [mul_le_mul_of_nonneg_right (show v ≤ 2 * u by linarith [hv.2]) hlog.le] have hdenlo : w / 2 ≤ v * log (1 + w / u) := by have h := (div_le_iff₀ (add_pos hu hw)).mp hlo nlinarith [mul_le_mul_of_nonneg_right (show u + w ≤ 2 * v by linarith [hv.1]) hlog.le] simp only [logUniformDensity, Set.indicator_of_mem hv] constructor · exact one_div_le_one_div_of_le hden hdenhi · calc _ ≤ 1 / (w / 2) := one_div_le_one_div_of_le (half_pos hw) hdenlo _ = _ := by field_simp theorem logUniformDensity_nonneg {u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) (v : ℝ) : 0 ≤ logUniformDensity u w v := by by_cases hv : v ∈ Set.Icc u (u + w) · exact (by positivity : (0 : ℝ) ≤ 1 / (2 * w)).trans (logUniformDensity_bounds hw hwu hv).1 · simp only [logUniformDensity, Set.indicator_of_notMem hv, le_refl] theorem logUniformDensity_le {u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) (v : ℝ) : logUniformDensity u w v ≤ 2 / w := by by_cases hv : v ∈ Set.Icc u (u + w) · exact (logUniformDensity_bounds hw hwu hv).2 · simp only [logUniformDensity, Set.indicator_of_notMem hv] positivity theorem logUniformDensity_eq_zero {u w v : ℝ} (hv : v ∉ Set.Icc u (u + w)) : logUniformDensity u w v = 0 := Set.indicator_of_notMem hv _ theorem integrable_logUniformDensity {u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) : Integrable (logUniformDensity u w) := by have hmajor : Integrable ((Set.Icc u (u + w)).indicator (fun _ ↦ (2 : ℝ) / w)) := (integrableOn_const isCompact_Icc.measure_ne_top).integrable_indicator measurableSet_Icc apply hmajor.mono_nonneg (measurable_logUniformDensity u w).aestronglyMeasurable (Filter.Eventually.of_forall (logUniformDensity_nonneg hw hwu)) filter_upwards [] with v by_cases hv : v ∈ Set.Icc u (u + w) · simpa only [Set.indicator_of_mem hv] using logUniformDensity_le hw hwu v · simp only [logUniformDensity_eq_zero hv, Set.indicator_of_notMem hv, le_refl] theorem integral_logUniformDensity {u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) : (∫ v : ℝ, logUniformDensity u w v) = 1 := by have hu : 0 < u := hw.trans_le hwu have hlog := (logUniform_log_bounds hw hwu).1 have hfun : (fun v : ℝ ↦ 1 / (v * log (1 + w / u))) = fun v ↦ (1 / log (1 + w / u)) * (1 / v) := by funext v; ring unfold logUniformDensity rw [integral_indicator measurableSet_Icc, hfun, integral_const_mul, integral_Icc_eq_integral_Ioc, ← intervalIntegral.integral_of_le (by linarith : u ≤ u + w), integral_one_div_of_pos hu (add_pos hu hw)] have hr : (u + w) / u = 1 + w / u := by field_simp rw [hr] simp only [one_div, inv_mul_cancel₀ hlog.ne'] theorem lintegral_logUniformDensity {u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) : (∫⁻ v : ℝ, ENNReal.ofReal (logUniformDensity u w v)) = 1 := by rw [← ofReal_integral_eq_lintegral_ofReal (integrable_logUniformDensity hw hwu) (Filter.Eventually.of_forall (logUniformDensity_nonneg hw hwu)), integral_logUniformDensity hw hwu, ENNReal.ofReal_one] /-- Density of the difference of two independent draws from `f`. -/ noncomputable def pairDifferenceDensity (f : ℝ → ℝ) (t : ℝ) : ℝ := ∫ x : ℝ, f x * f (x - t) theorem pairDifferenceDensity_eq_convolution (f : ℝ → ℝ) : pairDifferenceDensity f = convolution f (fun x ↦ f (-x)) (ContinuousLinearMap.lsmul ℝ ℝ) volume := by funext t simp only [pairDifferenceDensity, convolution_def, ContinuousLinearMap.lsmul_apply, smul_eq_mul, neg_sub] theorem measurable_pairDifferenceDensity {f : ℝ → ℝ} (hf : Measurable f) : Measurable (pairDifferenceDensity f) := by exact ((hf.comp measurable_snd).mul (hf.comp (measurable_snd.sub measurable_fst))).stronglyMeasurable.integral_prod_right'.measurable theorem pairDifferenceDensity_nonneg {f : ℝ → ℝ} (hf0 : ∀ x, 0 ≤ f x) (t : ℝ) : 0 ≤ pairDifferenceDensity f t := integral_nonneg (fun x ↦ mul_nonneg (hf0 x) (hf0 (x - t))) theorem integrable_pairDifferenceDensity {f : ℝ → ℝ} (hf : Integrable f) : Integrable (pairDifferenceDensity f) := by rw [pairDifferenceDensity_eq_convolution] exact hf.integrable_convolution (ContinuousLinearMap.lsmul ℝ ℝ) hf.comp_neg theorem integral_pairDifferenceDensity {f : ℝ → ℝ} (hf : Integrable f) : (∫ t : ℝ, pairDifferenceDensity f t) = (∫ x : ℝ, f x) ^ 2 := by rw [pairDifferenceDensity_eq_convolution, integral_convolution (ContinuousLinearMap.lsmul ℝ ℝ) hf hf.comp_neg, integral_neg_eq_self] simp only [ContinuousLinearMap.lsmul_apply, smul_eq_mul, pow_two] theorem integrable_pairDifference_integrand {f : ℝ → ℝ} (hfm : Measurable f) (hfi : Integrable f) (hf0 : ∀ x, 0 ≤ f x) {M : ℝ} (hM : ∀ x, f x ≤ M) (t : ℝ) : Integrable (fun x ↦ f x * f (x - t)) := by apply (hfi.mul_const M).mono_nonneg (hfm.mul (hfm.comp (measurable_id.sub measurable_const))).aestronglyMeasurable (Filter.Eventually.of_forall (fun x ↦ mul_nonneg (hf0 x) (hf0 (x - t)))) exact Filter.Eventually.of_forall (fun x ↦ mul_le_mul_of_nonneg_left (hM (x - t)) (hf0 x)) theorem pairDifferenceDensity_le {f : ℝ → ℝ} (hfm : Measurable f) (hfi : Integrable f) (hf0 : ∀ x, 0 ≤ f x) (hnorm : (∫ x : ℝ, f x) = 1) {M : ℝ} (hM : ∀ x, f x ≤ M) (t : ℝ) : pairDifferenceDensity f t ≤ M := by calc _ ≤ ∫ x : ℝ, f x * M := integral_mono (integrable_pairDifference_integrand hfm hfi hf0 hM t) (hfi.mul_const M) (fun x ↦ mul_le_mul_of_nonneg_left (hM (x - t)) (hf0 x)) _ = _ := by rw [integral_mul_const, hnorm, one_mul] theorem pairDifferenceDensity_eq_zero_outside {f : ℝ → ℝ} {u w t : ℝ} (hsupp : ∀ x, x ∉ Set.Icc u (u + w) → f x = 0) (ht : t ∉ Set.Icc (-w) w) : pairDifferenceDensity f t = 0 := by have hzero : (fun x ↦ f x * f (x - t)) = fun _ ↦ (0 : ℝ) := by funext x by_cases hx : x ∈ Set.Icc u (u + w) · have hxt : x - t ∉ Set.Icc u (u + w) := by intro hxt apply ht constructor <;> linarith [hx.1, hx.2, hxt.1, hxt.2] rw [hsupp (x - t) hxt, mul_zero] · rw [hsupp x hx, zero_mul] rw [pairDifferenceDensity, hzero, integral_zero] /-- Interval lower bounds on a density give a triangular lower bound on its pair-difference density. -/ theorem pairDifferenceDensity_interval_lower {f : ℝ → ℝ} {u w : ℝ} (hw : 0 < w) (hfm : Measurable f) (hfi : Integrable f) (hf0 : ∀ x, 0 ≤ f x) (hupper : ∀ x, f x ≤ 2 / w) (hlower : ∀ x ∈ Set.Icc u (u + w), 1 / (2 * w) ≤ f x) (t : ℝ) : max (w - |t|) 0 / (4 * w ^ 2) ≤ pairDifferenceDensity f t := by have hlo : ∀ x, intervalSmoothingKernel w u x / 2 ≤ f x := by intro x by_cases hx : x ∈ Set.Icc u (u + w) · simpa only [intervalSmoothingKernel, Set.indicator_of_mem hx, div_div, mul_comm] using hlower x hx · simpa only [intervalSmoothingKernel, Set.indicator_of_notMem hx, zero_div] using hf0 x have hkernel : ∀ x, intervalSmoothingKernel w (u + t) x = intervalSmoothingKernel w u (x - t) := by intro x have hm : x ∈ Set.Icc (u + t) (u + t + w) ↔ x - t ∈ Set.Icc u (u + w) := by constructor <;> intro h <;> constructor <;> linarith [h.1, h.2] simp only [intervalSmoothingKernel, Set.indicator_apply, hm] calc _ = (1 / 4 : ℝ) * (∫ x : ℝ, intervalSmoothingKernel w u x * intervalSmoothingKernel w (u + t) x) := by rw [integral_intervalSmoothingKernel_mul] have he : u - (u + t) = -t := by ring rw [he, abs_neg] ring _ = ∫ x : ℝ, (1 / 4 : ℝ) * (intervalSmoothingKernel w u x * intervalSmoothingKernel w (u + t) x) := (integral_const_mul _ _).symm _ ≤ _ := by apply integral_mono ((integrable_intervalSmoothingKernel_mul w u (u + t)).const_mul _) (integrable_pairDifference_integrand hfm hfi hf0 hupper t) intro x change (1 / 4 : ℝ) * (intervalSmoothingKernel w u x * intervalSmoothingKernel w (u + t) x) ≤ f x * f (x - t) rw [hkernel] have h := mul_le_mul (hlo x) (hlo (x - t)) (div_nonneg (intervalSmoothingKernel_nonneg hw.le u (x - t)) (by norm_num)) (hf0 x) nlinarith theorem translationShiftLaw_map_neg (f : ℝ → ℝ) : (translationShiftLaw f).map Neg.neg = translationShiftLaw (fun x ↦ f (-x)) := by classical apply Measure.ext intro S hS simp only [translationShiftLaw] rw [Measure.map_apply measurable_neg hS, withDensity_apply _ (hS.preimage measurable_neg), withDensity_apply _ hS, ← lintegral_indicator (hS.preimage measurable_neg), ← lintegral_indicator hS] have heq : ((Neg.neg ⁻¹' S).indicator (fun x ↦ ENNReal.ofReal (f x))) = fun x ↦ S.indicator (fun y ↦ ENNReal.ofReal (f (-y))) (-x) := by funext x by_cases hx : -x ∈ S <;> simp [hx] rw [heq, lintegral_neg_eq_self] /-- The density is the pushforward of the product law under subtraction. -/ theorem pairDifferenceDensity_map_eq {f : ℝ → ℝ} (hfm : Measurable f) (hfi : Integrable f) (hf0 : ∀ x, 0 ≤ f x) (hnorm : (∫ x : ℝ, f x) = 1) {M : ℝ} (hM : ∀ x, f x ≤ M) : (translationShiftLaw f |>.prod (translationShiftLaw f)).map (fun z : ℝ × ℝ ↦ z.1 - z.2) = translationShiftLaw (pairDifferenceDensity f) := by have hmass : (∫⁻ x : ℝ, ENNReal.ofReal (f x)) = 1 := by rw [← ofReal_integral_eq_lintegral_ofReal hfi (Filter.Eventually.of_forall hf0), hnorm, ENNReal.ofReal_one] let : IsProbabilityMeasure (translationShiftLaw f) := translationShiftLaw_isProbability f hmass have hprod := Measure.map_prod_map (translationShiftLaw f) (translationShiftLaw f) measurable_id (measurable_neg : Measurable (Neg.neg : ℝ → ℝ)) simp only [Measure.map_id] at hprod have hdiff : (translationShiftLaw f |>.prod (translationShiftLaw f)).map (fun z : ℝ × ℝ ↦ z.1 - z.2) = Measure.conv (translationShiftLaw f) ((translationShiftLaw f).map Neg.neg) := by rw [Measure.conv, hprod, Measure.map_map (by fun_prop) (by fun_prop)] congr 1 have hdensity : lconvolution (fun x ↦ ENNReal.ofReal (f x)) (fun x ↦ ENNReal.ofReal (f (-x))) volume = fun t ↦ ENNReal.ofReal (pairDifferenceDensity f t) := by funext t rw [lconvolution_def, pairDifferenceDensity, ofReal_integral_eq_lintegral_ofReal (integrable_pairDifference_integrand hfm hfi hf0 hM t) (Filter.Eventually.of_forall (fun x ↦ mul_nonneg (hf0 x) (hf0 (x - t))))] apply lintegral_congr intro x have he : -(-x + t) = x - t := by ring rw [he, ENNReal.ofReal_mul (hf0 x)] rw [hdiff, translationShiftLaw_map_neg] change Measure.conv (volume.withDensity (fun x ↦ ENNReal.ofReal (f x))) (volume.withDensity (fun x ↦ ENNReal.ofReal (f (-x)))) = _ have hnegm : Measurable (fun x ↦ ENNReal.ofReal (f (-x))) := (hfm.comp measurable_neg).ennreal_ofReal rw [conv_withDensity_eq_lconvolution hfm.ennreal_ofReal hnegm, hdensity] rfl noncomputable def logUniformPairDensity (u w : ℝ) : ℝ → ℝ := pairDifferenceDensity (logUniformDensity u w) theorem logUniformPairDensity_properties {u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) : Measurable (logUniformPairDensity u w) ∧ (∀ t, 0 ≤ logUniformPairDensity u w t) ∧ (∫⁻ t : ℝ, ENNReal.ofReal (logUniformPairDensity u w t)) = 1 ∧ (∀ t, t ∉ Set.Icc (-w) w → logUniformPairDensity u w t = 0) ∧ (∀ t, logUniformPairDensity u w t ≤ 2 / w) ∧ (∀ t, max (w - |t|) 0 / (4 * w ^ 2) ≤ logUniformPairDensity u w t) := by have hm := measurable_logUniformDensity u w have hi := integrable_logUniformDensity hw hwu have h0 := logUniformDensity_nonneg hw hwu have h1 := integral_logUniformDensity hw hwu have hu := logUniformDensity_le hw hwu refine ⟨measurable_pairDifferenceDensity hm, pairDifferenceDensity_nonneg h0, ?_, (fun _ ht ↦ pairDifferenceDensity_eq_zero_outside (fun _ hx ↦ logUniformDensity_eq_zero hx) ht), pairDifferenceDensity_le hm hi h0 h1 hu, ?_⟩ · change (∫⁻ t : ℝ, ENNReal.ofReal (pairDifferenceDensity (logUniformDensity u w) t)) = 1 rw [← ofReal_integral_eq_lintegral_ofReal (integrable_pairDifferenceDensity hi) (Filter.Eventually.of_forall (pairDifferenceDensity_nonneg h0)), integral_pairDifferenceDensity hi, h1, one_pow, ENNReal.ofReal_one] · exact pairDifferenceDensity_interval_lower hw hm hi h0 hu (fun _ hx ↦ (logUniformDensity_bounds hw hwu hx).1) theorem logUniformPairDensity_initial_lower {u L t : ℝ} (hL : 0 < L) (hu : 4 * L ≤ u) (ht : |t| ≤ L) : 3 / (64 * L) ≤ logUniformPairDensity u (4 * L) t := by have h := (logUniformPairDensity_properties (by positivity : (0 : ℝ) < 4 * L) hu).2.2.2.2.2 t apply le_trans _ h have hnonneg : 0 ≤ 4 * L - |t| := by linarith rw [max_eq_left hnonneg] apply (div_le_div_iff₀ (by positivity : (0 : ℝ) < 64 * L) (by positivity : (0 : ℝ) < 4 * (4 * L) ^ 2)).mpr nlinarith [sq_nonneg L] theorem logUniformPairDensity_map_eq {u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) : (translationShiftLaw (logUniformDensity u w) |>.prod (translationShiftLaw (logUniformDensity u w))).map (fun z : ℝ × ℝ ↦ z.1 - z.2) = translationShiftLaw (logUniformPairDensity u w) := pairDifferenceDensity_map_eq (measurable_logUniformDensity u w) (integrable_logUniformDensity hw hwu) (logUniformDensity_nonneg hw hwu) (integral_logUniformDensity hw hwu) (logUniformDensity_le hw hwu) end Erdos859Verification end /- Inlined development module: CyclicBallot.lean -/ section /- A deterministic cyclic ballot lemma and its finite weighted consequence. -/ open Finset namespace Erdos859Verification /-- Start a zero-sum periodic walk after a maximal partial sum. -/ theorem periodic_zero_sum_exists_nonpos_prefix {n : ℕ} (hn : 0 < n) (f : ℕ → ℤ) (hp : Function.Periodic f n) (hs : ∑ i ∈ range n, f i = 0) : ∃ r < n, ∀ k ≤ n, (∑ i ∈ range k, f (r + i)) ≤ 0 := by let s : ℕ → ℤ := fun k ↦ ∑ i ∈ range k, f i obtain ⟨r, hr, hmax⟩ := (range n).exists_max_image s ⟨0, mem_range.mpr hn⟩ refine ⟨r, mem_range.mp hr, ?_⟩ intro k hk have hsplit : s (r + k) = s r + ∑ i ∈ range k, f (r + i) := sum_range_add f r k have hbound : s (r + k) ≤ s r := by by_cases hsmall : r + k < n · exact hmax (r + k) (mem_range.mpr hsmall) · have ht : r + k - n < n := by have := mem_range.mp hr; omega have heq : s (r + k) = s (r + k - n) := by have he : r + k = n + (r + k - n) := by omega conv_lhs => rw [he] dsimp only [s] rw [sum_range_add] simp only [hs, zero_add] exact sum_congr rfl (fun i _ ↦ by simpa only [Nat.add_comm] using hp i) rw [heq] exact hmax _ (mem_range.mpr ht) omega def cyclicRotate {n : ℕ} {α : Type*} (r : Fin n) (x : Fin n → α) : Fin n → α := fun i ↦ x (finCycle r i) def CyclicBallot {n : ℕ} (x : Fin n → ℕ) : Prop := ∀ k ≤ n, (∑ i : Fin n with i.val < k, x i) ≤ k theorem sum_cyclicRotate_prefix {n k : ℕ} (hn : 0 < n) (hk : k ≤ n) (x : Fin n → ℕ) (r : Fin n) : (∑ i : Fin n with i.val < k, cyclicRotate r x i) = ∑ j ∈ range k, x ⟨(r.val + j) % n, Nat.mod_lt _ hn⟩ := by classical apply sum_bij (fun i _ ↦ i.val) · intro i hi exact mem_range.mpr (mem_filter.mp hi).2 · intro i _ j _ hij exact Fin.ext hij · intro j hj have hjn : j < n := (mem_range.mp hj).trans_le hk exact ⟨⟨j, hjn⟩, mem_filter.mpr ⟨mem_univ _, mem_range.mp hj⟩, rfl⟩ · intro i _ change x (finCycle r i) = x ⟨(r.val + i.val) % n, Nat.mod_lt _ hn⟩ congr 1 apply Fin.ext change (i.val + r.val) % n = (r.val + i.val) % n rw [Nat.add_comm] /-- Every natural tuple whose total equals its length has a cyclic rotation whose every prefix contains at most its length in total mass. -/ theorem exists_cyclic_ballot {n : ℕ} (hn : 0 < n) (x : Fin n → ℕ) (hsum : ∑ i, x i = n) : ∃ r : Fin n, CyclicBallot (cyclicRotate r x) := by let f : ℕ → ℤ := fun j ↦ (x ⟨j % n, Nat.mod_lt _ hn⟩ : ℤ) - 1 have hp : Function.Periodic f n := by intro j simp [f] have hs : (∑ j ∈ range n, f j) = 0 := by rw [← Fin.sum_univ_eq_sum_range f n] have hf (i : Fin n) : f i.val = (x i : ℤ) - 1 := by simp only [f, Nat.mod_eq_of_lt i.isLt] simp_rw [hf] rw [sum_sub_distrib] simp only [← Nat.cast_sum, hsum, sum_const, card_univ, Fintype.card_fin, nsmul_eq_mul, mul_one, sub_self] obtain ⟨r, hr, hprefix⟩ := periodic_zero_sum_exists_nonpos_prefix hn f hp hs refine ⟨⟨r, hr⟩, ?_⟩ intro k hk rw [sum_cyclicRotate_prefix hn hk] have h := hprefix k hk dsimp only [f] at h rw [sum_sub_distrib] at h simp only [sum_const, card_range, nsmul_eq_mul, mul_one] at h exact_mod_cast (sub_nonpos.mp h) def cyclicRotateEquiv {n : ℕ} {α : Type*} (r : Fin n) : Equiv.Perm (Fin n → α) where toFun := cyclicRotate r invFun x i := x ((finCycle r).symm i) left_inv x := by ext i change x (finCycle r ((finCycle r).symm i)) = x i rw [Equiv.apply_symm_apply] right_inv x := by ext i change x ((finCycle r).symm (finCycle r i)) = x i rw [Equiv.symm_apply_apply] theorem sum_cyclicRotate {n : ℕ} (x : Fin n → ℕ) (r : Fin n) : (∑ i, cyclicRotate r x i) = ∑ i, x i := Equiv.sum_comp (finCycle r) x /-- Finite weighted covering by permutations. Stabilizers cause no loss: no assertion that every orbit has the same cardinality is needed. -/ theorem weighted_permutation_cover {α ι : Type*} [DecidableEq α] [Fintype ι] (S : Finset α) (e : ι → Equiv.Perm α) (W : α → ℝ) (Good : α → Prop) [DecidablePred Good] (hS : ∀ r x, e r x ∈ S ↔ x ∈ S) (hW : ∀ x ∈ S, 0 ≤ W x) (hinv : ∀ r x, x ∈ S → W (e r x) = W x) (hcover : ∀ x ∈ S, ∃ r, Good (e r x)) : (∑ x ∈ S, W x) ≤ (Fintype.card ι : ℝ) * ∑ x ∈ S with Good x, W x := by classical have hinner (r : ι) : (∑ x ∈ S, if Good (e r x) then W x else 0) = ∑ x ∈ S with Good x, W x := by rw [sum_filter] apply sum_bij (fun x _ ↦ e r x) · intro x hx exact (hS r x).mpr hx · intro x _ y _ hxy exact (e r).injective hxy · intro y hy refine ⟨(e r).symm y, ?_, (e r).apply_symm_apply y⟩ exact (hS r _).mp (by simpa using hy) · intro x hx rw [hinv r x hx] calc _ ≤ ∑ x ∈ S, ∑ r : ι, if Good (e r x) then W x else 0 := by apply sum_le_sum intro x hx obtain ⟨r, hr⟩ := hcover x hx have hnonneg (i : ι) : 0 ≤ if Good (e i x) then W x else 0 := by split_ifs <;> first | exact hW x hx | exact le_rfl simpa only [if_pos hr] using single_le_sum (fun i _ ↦ hnonneg i) (mem_univ r) _ = ∑ r : ι, ∑ x ∈ S, if Good (e r x) then W x else 0 := sum_comm _ = _ := by simp only [hinner, sum_const, card_univ, nsmul_eq_mul] /-- Among tuples of total mass `n`, every rotation-invariant nonnegative weight assigns at least a `1/n` fraction to the ballot event. -/ theorem cyclic_ballot_weight_lower {n : ℕ} (hn : 0 < n) (S : Finset (Fin n → ℕ)) (W : (Fin n → ℕ) → ℝ) (hS : ∀ r x, cyclicRotate r x ∈ S ↔ x ∈ S) (hW : ∀ x ∈ S, 0 ≤ W x) (hinv : ∀ r x, x ∈ S → W (cyclicRotate r x) = W x) (htotal : ∀ x ∈ S, ∑ i, x i = n) : (∑ x ∈ S, W x) / n ≤ ∑ x ∈ S with CyclicBallot x, W x := by have h := weighted_permutation_cover S cyclicRotateEquiv W CyclicBallot hS hW hinv (fun x hx ↦ exists_cyclic_ballot hn x (htotal x hx)) have hnR : (0 : ℝ) < n := by exact_mod_cast hn rw [div_le_iff₀ hnR] simpa only [Fintype.card_fin, mul_comm] using h theorem cyclic_ballot_conditional_weight_lower {n : ℕ} (hn : 0 < n) (S : Finset (Fin n → ℕ)) (W : (Fin n → ℕ) → ℝ) (hS : ∀ r x, cyclicRotate r x ∈ S ↔ x ∈ S) (hW : ∀ x ∈ S, 0 ≤ W x) (hinv : ∀ r x, x ∈ S → W (cyclicRotate r x) = W x) : (∑ x ∈ S with (∑ i, x i) = n, W x) / n ≤ ∑ x ∈ S with (∑ i, x i) = n ∧ CyclicBallot x, W x := by classical have h := cyclic_ballot_weight_lower hn (S.filter (fun x ↦ (∑ i, x i) = n)) W (fun r x ↦ by simp only [mem_filter, hS, sum_cyclicRotate]) (fun x hx ↦ hW x (mem_filter.mp hx).1) (fun r x hx ↦ hinv r x (mem_filter.mp hx).1) (fun _ hx ↦ (mem_filter.mp hx).2) simpa only [filter_filter] using h theorem cyclic_ballot_conditional_probability_lower {n : ℕ} (hn : 0 < n) (S : Finset (Fin n → ℕ)) (W : (Fin n → ℕ) → ℝ) (hS : ∀ r x, cyclicRotate r x ∈ S ↔ x ∈ S) (hW : ∀ x ∈ S, 0 ≤ W x) (hinv : ∀ r x, x ∈ S → W (cyclicRotate r x) = W x) (hmass : 0 < ∑ x ∈ S with (∑ i, x i) = n, W x) : 1 / (n : ℝ) ≤ (∑ x ∈ S with (∑ i, x i) = n ∧ CyclicBallot x, W x) / (∑ x ∈ S with (∑ i, x i) = n, W x) := by have hnR : (0 : ℝ) < n := by exact_mod_cast hn apply (div_le_div_iff₀ hnR hmass).mpr simpa only [one_mul] using (div_le_iff₀ hnR).mp (cyclic_ballot_conditional_weight_lower hn S W hS hW hinv) theorem cyclic_ballot_card_lower {n : ℕ} (hn : 0 < n) (S : Finset (Fin n → ℕ)) (hS : ∀ r x, cyclicRotate r x ∈ S ↔ x ∈ S) (htotal : ∀ x ∈ S, ∑ i, x i = n) : (S.card : ℝ) / n ≤ (S.filter CyclicBallot).card := by simpa using cyclic_ballot_weight_lower hn S (fun _ ↦ 1) hS (fun _ _ ↦ zero_le_one) (fun _ _ _ ↦ rfl) htotal end Erdos859Verification end /- Inlined development module: FiniteResidueCovering.lean -/ section /- Fourier criteria for a finite collection of sums to cover every residue. -/ open Finset namespace Erdos859Verification theorem addChar_map_finset_sum {A ι : Type*} [AddCommMonoid A] (ψ : AddChar A ℂ) (s : Finset ι) (f : ι → A) : ψ (∑ i ∈ s, f i) = ∏ i ∈ s, ψ (f i) := by classical induction s using Finset.induction_on with | empty => simp | @insert i s hi ih => simp only [sum_insert hi, prod_insert hi, AddChar.map_add_eq_mul, ih] noncomputable def residueCharacterMean {r : ℕ} [NeZero r] {Ω : Type*} [Fintype Ω] (v : Ω → ZMod r) (a : ZMod r) : ℂ := (∑ z, ZMod.stdAddChar (a * v z)) / (Fintype.card Ω : ℂ) theorem residueCharacterMean_zero {r : ℕ} [NeZero r] {Ω : Type*} [Fintype Ω] [Nonempty Ω] (v : Ω → ZMod r) : residueCharacterMean v 0 = 1 := by have hc : (Fintype.card Ω : ℂ) ≠ 0 := by exact_mod_cast Fintype.card_ne_zero simp [residueCharacterMean, hc] theorem residueCharacterMean_missing {r : ℕ} [NeZero r] {Ω : Type*} [Fintype Ω] (v : Ω → ZMod r) {x : ZMod r} (hx : ∀ z, v z ≠ x) : (∑ a : ZMod r, residueCharacterMean v a * ZMod.stdAddChar (-(a * x))) = 0 := by simp only [residueCharacterMean, div_mul_eq_mul_div, ← sum_div] suffices (∑ a : ZMod r, (∑ z, ZMod.stdAddChar (a * v z)) * ZMod.stdAddChar (-(a * x))) = 0 by rw [this, zero_div] simp only [sum_mul, ← AddChar.map_add_eq_mul] rw [sum_comm] apply sum_eq_zero intro z _ have hn : v z - x ≠ 0 := sub_ne_zero.mpr (hx z) have h := AddChar.sum_eq_zero_of_ne_one (ZMod.isPrimitive_stdAddChar r hn) simp only [AddChar.mulShift_apply] at h convert h using 1 apply sum_congr rfl intro a _ congr 1 ring /-- If the total nonconstant Fourier mass is less than one, every residue is represented. The proof uses exact finite character orthogonality. -/ theorem residue_cover_of_fourier_mass_lt_one {r : ℕ} [NeZero r] {Ω : Type*} [Fintype Ω] [Nonempty Ω] (v : Ω → ZMod r) (hfourier : (∑ a ∈ (univ : Finset (ZMod r)).erase 0, ‖residueCharacterMean v a‖) < 1) : Function.Surjective v := by classical intro x by_contra hx have hn : ∀ z, v z ≠ x := by simpa only [not_exists] using hx have hsum := residueCharacterMean_missing v hn have hsplit := sum_erase_add (univ : Finset (ZMod r)) (fun a ↦ residueCharacterMean v a * ZMod.stdAddChar (-(a * x))) (mem_univ 0) rw [hsum, residueCharacterMean_zero] at hsplit simp only [zero_mul, neg_zero, AddChar.map_zero_eq_one, mul_one] at hsplit have hsumneg : (∑ a ∈ (univ : Finset (ZMod r)).erase 0, residueCharacterMean v a * ZMod.stdAddChar (-(a * x))) = -1 := by linear_combination hsplit have hnorm := norm_sum_le ((univ : Finset (ZMod r)).erase 0) (fun a ↦ residueCharacterMean v a * ZMod.stdAddChar (-(a * x))) rw [hsumneg] at hnorm simp only [norm_neg, norm_one, norm_mul, ZMod.stdAddChar_apply, Circle.norm_coe, mul_one] at hnorm exact (not_lt_of_ge hnorm) hfourier theorem residueCharacterMean_sum_copies {r : ℕ} [NeZero r] {Ω : Type*} [Fintype Ω] (v : Ω → ZMod r) (L : ℕ) (a : ZMod r) : residueCharacterMean (fun z : Fin L → Ω ↦ ∑ i, v (z i)) a = residueCharacterMean v a ^ L := by classical unfold residueCharacterMean simp only [mul_sum, addChar_map_finset_sum] rw [← Fintype.sum_pow (fun z : Ω ↦ ZMod.stdAddChar (a * v z)) L] simp only [Fintype.card_fun, Fintype.card_fin, Nat.cast_pow, div_pow] /-- Repeated sums amplify any uniform Fourier contraction. -/ theorem residue_cover_sum_copies {r : ℕ} [NeZero r] {Ω : Type*} [Fintype Ω] [Nonempty Ω] (v : Ω → ZMod r) {q : ℝ} (hcontract : ∀ a : ZMod r, a ≠ 0 → ‖residueCharacterMean v a‖ ≤ q) {L : ℕ} (hsmall : ((r : ℝ) - 1) * q ^ L < 1) : Function.Surjective (fun z : Fin L → Ω ↦ ∑ i, v (z i)) := by apply residue_cover_of_fourier_mass_lt_one calc _ ≤ ∑ _a ∈ (univ : Finset (ZMod r)).erase 0, q ^ L := by apply sum_le_sum intro a ha rw [residueCharacterMean_sum_copies, norm_pow] exact pow_le_pow_left₀ (norm_nonneg _) (hcontract a (mem_erase.mp ha).1) L _ = ((r : ℝ) - 1) * q ^ L := by rw [sum_const, nsmul_eq_mul, card_erase_of_mem (mem_univ 0), card_univ, ZMod.card] rw [Nat.cast_sub (Nat.one_le_iff_ne_zero.mpr (NeZero.ne r)), Nat.cast_one] _ < 1 := hsmall end Erdos859Verification end /- Inlined development module: FiniteCoinSums.lean -/ section /- Repeated Boolean coin sums give bounded nonnegative integer coefficients. -/ open Finset namespace Erdos859Verification def booleanCoinValue {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] (w : ι → ℕ) (c : ι → Bool) : ZMod r := ∑ i, if c i then (w i : ZMod r) else 0 theorem booleanCoin_copies_coefficients {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] (w : ι → ℕ) {L : ℕ} (z : Fin L → ι → Bool) : ∃ c : ι → ℕ, (∀ i, c i ≤ L) ∧ (∑ j, booleanCoinValue w (z j)) = ∑ i, (c i : ZMod r) * (w i : ZMod r) := by classical let c : ι → ℕ := fun i ↦ ∑ j : Fin L, if z j i then 1 else 0 refine ⟨c, ?_, ?_⟩ · intro i calc c i ≤ ∑ _j : Fin L, 1 := by apply sum_le_sum intro j _ cases z j i <;> norm_num _ = L := by simp · unfold booleanCoinValue rw [sum_comm] apply sum_congr rfl intro i _ simp only [c, Nat.cast_sum, sum_mul] apply sum_congr rfl intro j _ cases z j i <;> simp theorem bounded_coin_coefficients_of_copies_surjective {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] (w : ι → ℕ) {L : ℕ} (hcover : Function.Surjective (fun z : Fin L → ι → Bool ↦ ∑ j, booleanCoinValue (r := r) w (z j))) : ∀ x : ZMod r, ∃ c : ι → ℕ, (∀ i, c i ≤ L) ∧ (∑ i, c i * w i : ℕ) = x := by intro x obtain ⟨z, hz⟩ := hcover x obtain ⟨c, hc, hvalue⟩ := booleanCoin_copies_coefficients (r := r) w z refine ⟨c, hc, ?_⟩ push_cast exact hvalue.symm.trans hz theorem bounded_coin_coefficients_of_fourier_contraction {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] [DecidableEq ι] (w : ι → ℕ) {q : ℝ} (hcontract : ∀ a : ZMod r, a ≠ 0 → ‖residueCharacterMean (booleanCoinValue w) a‖ ≤ q) {L : ℕ} (hsmall : ((r : ℝ) - 1) * q ^ L < 1) : ∀ x : ZMod r, ∃ c : ι → ℕ, (∀ i, c i ≤ L) ∧ (∑ i, c i * w i : ℕ) = x := bounded_coin_coefficients_of_copies_surjective w (residue_cover_sum_copies (booleanCoinValue w) hcontract hsmall) theorem bounded_coin_value_le {ι : Type*} [Fintype ι] (w : ι → ℕ) {c : ι → ℕ} {L : ℕ} (hc : ∀ i, c i ≤ L) : (∑ i, c i * w i) ≤ L * ∑ i, w i := by rw [mul_sum] exact sum_le_sum (fun i _ ↦ Nat.mul_le_mul_right (w i) (hc i)) end Erdos859Verification end /- Inlined development module: ExponentialResidueCovering.lean -/ section /- Explicit repetition lengths for exponential Fourier contraction. -/ namespace Erdos859Verification theorem exponential_residue_mass_lt_one {r L : ℕ} [NeZero r] {u : ℝ} (hL : Real.log (2 * (r : ℝ)) ≤ u * (L : ℝ)) : ((r : ℝ) - 1) * Real.exp (-u) ^ L < 1 := by have hr : (1 : ℝ) ≤ r := by exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne r) have hrpos : (0 : ℝ) < 2 * (r : ℝ) := by linarith have he : Real.exp (-u) ^ L ≤ 1 / (2 * (r : ℝ)) := by rw [← Real.exp_nat_mul] calc _ ≤ Real.exp (-Real.log (2 * (r : ℝ))) := Real.exp_le_exp.mpr (by nlinarith) _ = _ := by rw [Real.exp_neg, Real.exp_log hrpos, one_div] calc _ ≤ ((r : ℝ) - 1) * (1 / (2 * (r : ℝ))) := mul_le_mul_of_nonneg_left he (by linarith) _ < 1 := by rw [mul_one_div, div_lt_iff₀ hrpos]; linarith noncomputable def bernoulliResidueLength (r : ℕ) (Y : ℝ) : ℕ := ⌈Y ^ 2 * Real.log (2 * (r : ℝ))⌉₊ theorem bernoulliResidueLength_sufficient {r : ℕ} [NeZero r] {Y : ℝ} (hY : 0 < Y) : ((r : ℝ) - 1) * Real.exp (-(2 / Y ^ 2)) ^ bernoulliResidueLength r Y < 1 := by have hr : (1 : ℝ) ≤ r := by exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne r) have hlog : 0 ≤ Real.log (2 * (r : ℝ)) := Real.log_nonneg (by linarith) have hceil : Y ^ 2 * Real.log (2 * (r : ℝ)) ≤ (bernoulliResidueLength r Y : ℝ) := Nat.le_ceil _ apply exponential_residue_mass_lt_one rw [div_mul_eq_mul_div] apply (le_div_iff₀ (sq_pos_of_pos hY)).mpr have hp := mul_nonneg (sq_nonneg Y) hlog nlinarith theorem bernoulliResidueLength_le {r : ℕ} [NeZero r] (Y : ℝ) : (bernoulliResidueLength r Y : ℝ) ≤ Y ^ 2 * Real.log (2 * (r : ℝ)) + 1 := by have hr : (1 : ℝ) ≤ r := by exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne r) exact (Nat.ceil_lt_add_one (mul_nonneg (sq_nonneg Y) (Real.log_nonneg (by linarith)))).le theorem bounded_coin_coefficients_of_exponential_contraction {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] [DecidableEq ι] (w : ι → ℕ) {Y : ℝ} (hY : 0 < Y) (hcontract : ∀ a : ZMod r, a ≠ 0 → ‖residueCharacterMean (booleanCoinValue w) a‖ ≤ Real.exp (-(2 / Y ^ 2))) : ∀ x : ZMod r, ∃ c : ι → ℕ, (∀ i, c i ≤ bernoulliResidueLength r Y) ∧ (∑ i, c i * w i : ℕ) = x := bounded_coin_coefficients_of_fourier_contraction w hcontract (bernoulliResidueLength_sufficient hY) end Erdos859Verification end /- Inlined development module: BernoulliPhaseDecay.lean -/ section /- Fourier decay of independent fair Bernoulli digits. -/ open Finset Real namespace Erdos859Verification theorem norm_bernoulli_factor_sq (z : ℂ) (hz : ‖z‖ = 1) : ‖(1 + z) / 2‖ ^ 2 = (1 + z.re) / 2 := by have hzsq : z.re * z.re + z.im * z.im = 1 := by simpa only [Complex.normSq_apply, hz, one_pow] using Complex.normSq_eq_norm_sq z rw [norm_div, Complex.norm_ofNat, div_pow, Complex.sq_norm, Complex.normSq_apply] simp only [Complex.add_re, Complex.one_re, Complex.add_im, Complex.one_im, zero_add] nlinarith theorem fourier_one_re_centered (a : ℝ) : (fourier 1 (a : AddCircle (1 : ℝ))).re = cos (2 * Real.pi * (a - (round a : ℝ))) := by simpa [signedCubeValue] using signedCube_fourier_re_centered (fun _ : Fin 1 ↦ 1) (fun _ ↦ 1) a /-- The circle distance controls the squared norm of a fair coin transform. -/ theorem bernoulli_circle_norm_sq_le (x : AddCircle (1 : ℝ)) : ‖(1 + fourier 1 x) / 2‖ ^ 2 ≤ 1 - 4 * ‖x‖ ^ 2 := by induction x using QuotientAddGroup.induction_on with | H a => let t : ℝ := a - (round a : ℝ) have ht : |t| ≤ 1 / 2 := by simpa only [UnitAddCircle.norm_eq, abs_one] using (AddCircle.norm_le_half_period (1 : ℝ) (by norm_num) (x := (a : AddCircle (1 : ℝ)))) have hangle : |2 * Real.pi * t| ≤ Real.pi := by rw [abs_mul, abs_of_pos (by positivity : (0 : ℝ) < 2 * Real.pi)] nlinarith [Real.pi_pos] have hcos := Real.cos_le_one_sub_mul_cos_sq hangle have hcoef : 2 / Real.pi ^ 2 * (2 * Real.pi * t) ^ 2 = 8 * t ^ 2 := by field_simp ring rw [hcoef] at hcos have hz : ‖fourier 1 (a : AddCircle (1 : ℝ))‖ = 1 := by rw [fourier_apply] exact Circle.norm_coe _ rw [norm_bernoulli_factor_sq _ hz, fourier_one_re_centered, UnitAddCircle.norm_eq, sq_abs] change (1 + cos (2 * Real.pi * t)) / 2 ≤ 1 - 4 * t ^ 2 linarith /-- Uniform Gaussian decay, including the half-period where the factor is zero. -/ theorem bernoulli_circle_decay (x : AddCircle (1 : ℝ)) : ‖(1 + fourier 1 x) / 2‖ ≤ exp (-2 * ‖x‖ ^ 2) := by apply (sq_le_sq₀ (norm_nonneg _) (exp_pos _).le).mp calc _ ≤ 1 - 4 * ‖x‖ ^ 2 := bernoulli_circle_norm_sq_le x _ ≤ exp (-4 * ‖x‖ ^ 2) := by linarith [Real.add_one_le_exp (-4 * ‖x‖ ^ 2)] _ = _ := by rw [← exp_nat_mul]; congr 1; ring theorem bernoulli_product_decay {ι : Type*} [Fintype ι] (w : ι → ℕ) (x : AddCircle (1 : ℝ)) : ‖∏ i, ((1 + fourier 1 (w i • x)) / 2)‖ ≤ exp (-2 * cubePhaseSquare w x) := by classical rw [norm_prod] calc _ ≤ ∏ i, exp (-2 * ‖w i • x‖ ^ 2) := prod_le_prod (fun _ _ ↦ norm_nonneg _) (fun i _ ↦ bernoulli_circle_decay (w i • x)) _ = _ := by rw [← exp_sum]; simp only [cubePhaseSquare, ← mul_sum] end Erdos859Verification end /- Inlined development module: BernoulliResidueDecay.lean -/ section /- Fair Boolean digits connect circle decay to finite residue characters. -/ open Finset Real namespace Erdos859Verification theorem stdAddChar_eq_fourier_one {r : ℕ} [NeZero r] (a : ZMod r) : ZMod.stdAddChar a = fourier 1 (ZMod.toAddCircle a) := by rw [fourier_one] rfl theorem stdAddChar_mul_nat_eq_fourier {r : ℕ} [NeZero r] (a : ZMod r) (w : ℕ) : ZMod.stdAddChar (a * (w : ZMod r)) = fourier 1 (w • ZMod.toAddCircle a) := by rw [stdAddChar_eq_fourier_one] congr 1 have hmul : a * (w : ZMod r) = w • a := by simp only [nsmul_eq_mul, mul_comm] rw [hmul, map_nsmul] theorem residueCharacterMean_booleanCoinValue {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] [DecidableEq ι] (w : ι → ℕ) (a : ZMod r) : residueCharacterMean (booleanCoinValue w) a = ∏ i, ((1 + ZMod.stdAddChar (a * (w i : ZMod r))) / 2) := by classical have hchar (c : ι → Bool) : ZMod.stdAddChar (a * booleanCoinValue w c) = ∏ i, if c i then ZMod.stdAddChar (a * (w i : ZMod r)) else 1 := by unfold booleanCoinValue rw [mul_sum, addChar_map_finset_sum] apply prod_congr rfl intro i _ cases c i <;> simp have hsum (i : ι) : (∑ b : Bool, if b then ZMod.stdAddChar (a * (w i : ZMod r)) else 1) = 1 + ZMod.stdAddChar (a * (w i : ZMod r)) := by simp [add_comm] unfold residueCharacterMean simp_rw [hchar] rw [← Fintype.prod_sum (fun i (b : Bool) ↦ if b then ZMod.stdAddChar (a * (w i : ZMod r)) else 1)] simp_rw [hsum] rw [prod_div_distrib] simp only [prod_const, card_univ, Fintype.card_fun, Fintype.card_bool, Nat.cast_pow, Nat.cast_ofNat] theorem booleanCoin_character_decay {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] [DecidableEq ι] (w : ι → ℕ) (a : ZMod r) : ‖residueCharacterMean (booleanCoinValue w) a‖ ≤ exp (-2 * cubePhaseSquare w (ZMod.toAddCircle a)) := by rw [residueCharacterMean_booleanCoinValue] simp_rw [stdAddChar_mul_nat_eq_fourier] exact bernoulli_product_decay w (ZMod.toAddCircle a) theorem booleanCoin_character_decay_rational {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] [DecidableEq ι] (w : ι → ℕ) (a : ZMod r) : ‖residueCharacterMean (booleanCoinValue w) a‖ ≤ exp (-2 * cubePhaseSquare w ((a.val / r : ℝ) : AddCircle (1 : ℝ))) := by simpa only [ZMod.toAddCircle_apply] using booleanCoin_character_decay w a theorem booleanCoin_character_decay_of_phase_lower {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] [DecidableEq ι] (w : ι → ℕ) (a : ZMod r) {eta : ℝ} (hphase : eta ≤ cubePhaseSquare w (ZMod.toAddCircle a)) : ‖residueCharacterMean (booleanCoinValue w) a‖ ≤ exp (-2 * eta) := by exact (booleanCoin_character_decay w a).trans (Real.exp_le_exp.mpr (by linarith)) end Erdos859Verification end /- Inlined development module: BoundedResidueCovering.lean -/ section /- Absence of a small rational phase forces bounded coin sums to cover every residue. -/ namespace Erdos859Verification theorem bounded_coin_coefficients_of_phase_gap {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] (w : ι → ℕ) {Y : ℝ} (hY : 0 < Y) (hphase : ∀ a : ZMod r, a ≠ 0 → 1 / Y ^ 2 ≤ cubePhaseSquare w (ZMod.toAddCircle a)) : ∀ x : ZMod r, ∃ c : ι → ℕ, (∀ i, c i ≤ bernoulliResidueLength r Y) ∧ (∑ i, c i * w i : ℕ) = x := by classical apply bounded_coin_coefficients_of_exponential_contraction w hY intro a ha have h := booleanCoin_character_decay_of_phase_lower w a (hphase a ha) convert h using 1 congr 1 ring theorem bounded_coin_coefficients_of_no_small_rational_phase {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] (w : ι → ℕ) {Y : ℝ} (hY : 0 < Y) (hphase : ∀ a : ℕ, 0 < a → a < r → 1 / Y ^ 2 ≤ cubePhaseSquare w (((a : ℝ) / r : ℝ) : AddCircle (1 : ℝ))) : ∀ x : ZMod r, ∃ c : ι → ℕ, (∀ i, c i ≤ bernoulliResidueLength r Y) ∧ (∑ i, c i * w i : ℕ) = x := by apply bounded_coin_coefficients_of_phase_gap w hY intro a ha have haval : 0 < a.val := by apply Nat.pos_of_ne_zero intro hzero exact ha ((ZMod.val_eq_zero a).mp hzero) simpa only [ZMod.toAddCircle_apply] using hphase a.val haval (ZMod.val_lt a) /-- The representatives have an explicit ordinary integer size bound as well as a coefficient bound; this is the form used in practical-seed lifting. -/ theorem bounded_coin_representative_of_phase_gap {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] (w : ι → ℕ) {Y : ℝ} (hY : 0 < Y) (hphase : ∀ a : ZMod r, a ≠ 0 → 1 / Y ^ 2 ≤ cubePhaseSquare w (ZMod.toAddCircle a)) (x : ZMod r) : ∃ c : ι → ℕ, (∀ i, c i ≤ bernoulliResidueLength r Y) ∧ (∑ i, c i * w i : ℕ) = x ∧ (∑ i, c i * w i) ≤ bernoulliResidueLength r Y * ∑ i, w i := by obtain ⟨c, hc, hvalue⟩ := bounded_coin_coefficients_of_phase_gap w hY hphase x exact ⟨c, hc, hvalue, bounded_coin_value_le w hc⟩ end Erdos859Verification end /- Inlined development module: ResidueCoinInterval.lean -/ section /- A reserve coin turns bounded residue representatives into an interval. -/ open Finset namespace Erdos859Verification theorem coin_interval_of_residue_cover {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] (w : ι → ℕ) {C Z t : ℕ} (hcover : ∀ x : ZMod r, ∃ c : ι → ℕ, (∀ i, c i ≤ C) ∧ (∑ i, c i * w i : ℕ) = x) (htlo : C * ∑ i, w i ≤ t) (hthi : t ≤ Z * r) : ∃ b : ℕ, ∃ c : ι → ℕ, b ≤ Z ∧ (∀ i, c i ≤ C) ∧ t = r * b + ∑ i, c i * w i := by obtain ⟨c, hc, hresidue⟩ := hcover (t : ZMod r) let z : ℕ := ∑ i, c i * w i have hz : z ≤ t := (bounded_coin_value_le w hc).trans htlo have hmod : z ≡ t [MOD r] := (ZMod.natCast_eq_natCast_iff z t r).mp hresidue have hdiv : r ∣ t - z := hmod.dvd' refine ⟨(t - z) / r, c, ?_, hc, ?_⟩ · calc _ ≤ (Z * r) / r := Nat.div_le_div_right ((Nat.sub_le t z).trans hthi) _ = Z := Nat.mul_div_cancel Z (NeZero.pos r) · rw [Nat.mul_div_cancel' hdiv] exact (Nat.sub_add_cancel hz).symm theorem coin_interval_real_bounds {r : ℕ} [NeZero r] {ι : Type*} [Fintype ι] (w : ι → ℕ) {C Z t : ℕ} (hcover : ∀ x : ZMod r, ∃ c : ι → ℕ, (∀ i, c i ≤ C) ∧ (∑ i, c i * w i : ℕ) = x) (hsize : 4 * C * ∑ i, w i ≤ Z * r) (htlo : (Z : ℝ) * r / 4 ≤ t) (hthi : (t : ℝ) ≤ 3 * Z * r / 4) : ∃ b : ℕ, ∃ c : ι → ℕ, b ≤ Z ∧ (∀ i, c i ≤ C) ∧ t = r * b + ∑ i, c i * w i := by apply coin_interval_of_residue_cover w hcover · have hs : (4 : ℝ) * C * (∑ i, w i : ℕ) ≤ Z * r := by exact_mod_cast hsize have h : (C : ℝ) * (∑ i, w i : ℕ) ≤ t := by nlinarith exact_mod_cast h · have h : (t : ℝ) ≤ (Z : ℝ) * r := by have hn : (0 : ℝ) ≤ (Z : ℝ) * r := by positivity nlinarith exact_mod_cast h /-- Embed a reserve coin and a disjoint finite set of other coins in one bounded coefficient function on the natural numbers. -/ theorem finite_coin_coefficient_extension (S : Finset ℕ) {r b C Z : ℕ} (hr : r ∉ S) (hb : b ≤ Z) (hCZ : C ≤ Z) (c : S → ℕ) (hc : ∀ i, c i ≤ C) : ∃ f : ℕ → ℕ, (∀ d, f d ≤ Z) ∧ (∀ d, d ∉ insert r S → f d = 0) ∧ (∑ d ∈ insert r S, d * f d) = r * b + ∑ i : S, c i * (i : ℕ) := by classical let f : ℕ → ℕ := fun d ↦ if d = r then b else if hd : d ∈ S then c ⟨d, hd⟩ else 0 refine ⟨f, ?_, ?_, ?_⟩ · intro d dsimp [f] split_ifs with h h' · exact hb · exact (hc ⟨d, h'⟩).trans hCZ · exact Nat.zero_le _ · intro d hd have hne : d ≠ r := by intro h; subst d; exact hd (mem_insert_self _ _) have hnot : d ∉ S := fun h ↦ hd (mem_insert_of_mem h) simp only [f, if_neg hne, dif_neg hnot] · rw [sum_insert hr] have hfr : f r = b := by simp [f] rw [hfr] congr 1 rw [← sum_attach] change (∑ i : S, (i : ℕ) * f i) = _ apply sum_congr rfl intro i _ have hi : (i : ℕ) ≠ r := by intro h; exact hr (h ▸ i.property) simp only [f, if_neg hi, dif_pos i.property, mul_comm] end Erdos859Verification end /- Inlined development module: PhasePracticalLifting.lean -/ section /- A phase gap for divisor coins gives an actual interval of representable targets. -/ open Finset namespace Erdos859Verification theorem phaseGap_practical_mem_divisorSumSet {n b r Z t : ℕ} [NeZero r] (hb : Nat.IsPractical b) (hb0 : b ≠ 0) (hn0 : n ≠ 0) (hcop : Nat.Coprime b n) (hZb : Z ≤ b) (S : Finset ℕ) (hS : S ⊆ n.divisors) (hr : r ∈ n.divisors) (hrS : r ∉ S) {Y : ℝ} (hY : 0 < Y) (hphase : ∀ a : ℕ, 0 < a → a < r → 1 / Y ^ 2 ≤ cubePhaseSquare (fun d : S ↦ (d : ℕ)) (((a : ℝ) / r : ℝ) : AddCircle (1 : ℝ))) (hCZ : bernoulliResidueLength r Y ≤ Z) (hsize : 4 * bernoulliResidueLength r Y * ∑ d ∈ S, d ≤ Z * r) (htlo : (Z : ℝ) * r / 4 ≤ t) (hthi : (t : ℝ) ≤ 3 * Z * r / 4) : b * n ∈ Erdos859.DivisorSumSet t := by classical have hcover := bounded_coin_coefficients_of_no_small_rational_phase (fun d : S ↦ (d : ℕ)) hY hphase have hsize' : 4 * bernoulliResidueLength r Y * (∑ d : S, (d : ℕ)) ≤ Z * r := by change 4 * bernoulliResidueLength r Y * (∑ d ∈ S.attach, (d : ℕ)) ≤ Z * r rwa [Finset.sum_attach S (fun d : ℕ ↦ d)] obtain ⟨q, c, hq, hc, htarget⟩ := coin_interval_real_bounds (fun d : S ↦ (d : ℕ)) hcover hsize' htlo hthi obtain ⟨f, hf, hfzero, hsum⟩ := finite_coin_coefficient_extension S hrS hq hCZ c hc have hsub : insert r S ⊆ n.divisors := insert_subset hr hS have heq : (∑ d ∈ n.divisors, d * f d) = t := by calc _ = ∑ d ∈ insert r S, d * f d := by symm apply sum_subset hsub intro d _ hd rw [hfzero d hd, mul_zero] _ = r * q + ∑ d : S, c d * (d : ℕ) := hsum _ = t := htarget.symm have hrep := bounded_coefficients_mem_divisorSumSet hb hb0 hn0 hcop f (fun d _ ↦ (hf d).trans hZb) simpa only [heq] using hrep end Erdos859Verification end /- Inlined development module: BernoulliSeedScale.lean -/ section /- An enlarged practical seed absorbs the quadratic Bernoulli digit cost. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification noncomputable def bernoulliSeedScale (k : ℕ) : ℕ := ⌈exp (3 * (k : ℝ) ^ 3)⌉₊ noncomputable def bernoulliPhaseScale (k : ℕ) : ℕ := ⌈exp ((k : ℝ) ^ 3)⌉₊ theorem natCeil_exp_le_exp_add_one {t : ℝ} (ht : 0 ≤ t) : (⌈exp t⌉₊ : ℝ) ≤ exp (t + 1) := by have he : 1 ≤ exp t := Real.one_le_exp_iff.mpr ht have he1 : 2 ≤ exp (1 : ℝ) := by linarith [Real.add_one_le_exp (1 : ℝ)] calc _ ≤ exp t + 1 := (Nat.ceil_lt_add_one (exp_pos t).le).le _ ≤ exp t * 2 := by linarith _ ≤ exp t * exp 1 := mul_le_mul_of_nonneg_left he1 (exp_pos t).le _ = _ := (exp_add _ _).symm theorem bernoulliSeedScale_exp_bounds (k : ℕ) : exp (3 * (k : ℝ) ^ 3) ≤ (bernoulliSeedScale k : ℝ) ∧ (bernoulliSeedScale k : ℝ) ≤ exp (3 * (k : ℝ) ^ 3 + 1) := ⟨Nat.le_ceil _, natCeil_exp_le_exp_add_one (by positivity)⟩ theorem bernoulliPhaseScale_exp_bounds (k : ℕ) : exp ((k : ℝ) ^ 3) ≤ (bernoulliPhaseScale k : ℝ) ∧ (bernoulliPhaseScale k : ℝ) ≤ exp ((k : ℝ) ^ 3 + 1) := ⟨Nat.le_ceil _, natCeil_exp_le_exp_add_one (by positivity)⟩ theorem bernoulliSeedScale_pos (k : ℕ) : 0 < bernoulliSeedScale k := by have h := (exp_pos _).trans_le (bernoulliSeedScale_exp_bounds k).1 exact_mod_cast h theorem bernoulliPhaseScale_pos (k : ℕ) : 0 < bernoulliPhaseScale k := by have h := (exp_pos _).trans_le (bernoulliPhaseScale_exp_bounds k).1 exact_mod_cast h theorem bernoulliSeedScale_gt_210 {k : ℕ} (hk : 6 ≤ k) : 210 < bernoulliSeedScale k := by have hkR : (6 : ℝ) ≤ k := by exact_mod_cast hk have hp := pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 6) hkR 3 have he := Real.add_one_le_exp (3 * (k : ℝ) ^ 3) have hz := (bernoulliSeedScale_exp_bounds k).1 have h : (210 : ℝ) < bernoulliSeedScale k := by norm_num at hp; linarith exact_mod_cast h theorem bernoulliSeedScale_eventually_gt_210 : ∀ᶠ k in atTop, 210 < bernoulliSeedScale k := (eventually_ge_atTop 6).mono (fun _ hk ↦ bernoulliSeedScale_gt_210 hk) theorem bernoulliSeedScale_sq_lt {k : ℕ} (hk : 0 < k) : (bernoulliSeedScale k : ℝ) ^ 2 < exp (10 * (k : ℝ) ^ 3) := by have hkR : (1 : ℝ) ≤ k := by exact_mod_cast hk have hp := pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 1) hkR 3 have hs := pow_le_pow_left₀ (Nat.cast_nonneg (bernoulliSeedScale k)) (bernoulliSeedScale_exp_bounds k).2 2 calc _ ≤ exp (3 * (k : ℝ) ^ 3 + 1) ^ 2 := hs _ = exp (6 * (k : ℝ) ^ 3 + 2) := by rw [← exp_nat_mul]; congr 1; ring _ < _ := Real.exp_lt_exp.mpr (by norm_num at hp; linarith) theorem bernoulliSeedScale_cube_lt {k : ℕ} (hk : 2 ≤ k) : (bernoulliSeedScale k : ℝ) ^ 3 < exp (10 * (k : ℝ) ^ 3) := by have hkR : (2 : ℝ) ≤ k := by exact_mod_cast hk have hp := pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 2) hkR 3 have hs := pow_le_pow_left₀ (Nat.cast_nonneg (bernoulliSeedScale k)) (bernoulliSeedScale_exp_bounds k).2 3 calc _ ≤ exp (3 * (k : ℝ) ^ 3 + 1) ^ 3 := hs _ = exp (9 * (k : ℝ) ^ 3 + 3) := by rw [← exp_nat_mul]; congr 1; ring _ < _ := Real.exp_lt_exp.mpr (by norm_num at hp; linarith) theorem bernoulliSeedScale_loglog_bounds {k : ℕ} (hk : 0 < k) : 0 ≤ log (log (bernoulliSeedScale k : ℝ)) ∧ log (log (bernoulliSeedScale k : ℝ)) ≤ log 4 + 3 * log (k : ℝ) := by have hkR : (1 : ℝ) ≤ k := by exact_mod_cast hk have hkpos : (0 : ℝ) < k := by exact_mod_cast hk have hp := pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 1) hkR 3 norm_num at hp have hzpos : (0 : ℝ) < bernoulliSeedScale k := by exact_mod_cast bernoulliSeedScale_pos k have hlo := log_le_log (exp_pos _) (bernoulliSeedScale_exp_bounds k).1 have hhi := log_le_log hzpos (bernoulliSeedScale_exp_bounds k).2 rw [log_exp] at hlo hhi have hlogone : 1 ≤ log (bernoulliSeedScale k : ℝ) := by linarith refine ⟨log_nonneg hlogone, ?_⟩ have hlogbound : log (bernoulliSeedScale k : ℝ) ≤ 4 * (k : ℝ) ^ 3 := by linarith calc _ ≤ log (4 * (k : ℝ) ^ 3) := log_le_log (by linarith) hlogbound _ = _ := by rw [log_mul (by norm_num) (pow_ne_zero 3 hkpos.ne'), log_pow]; norm_num theorem tendsto_loglog_bernoulliSeedScale_div : Tendsto (fun k : ℕ ↦ log (log (bernoulliSeedScale k : ℝ)) / k) atTop (𝓝 0) := by have hlog : Tendsto (fun k : ℕ ↦ log (k : ℝ) / k) atTop (𝓝 0) := by simpa only [Function.comp_def, id_eq] using Real.isLittleO_log_id_atTop.tendsto_div_nhds_zero.comp (tendsto_natCast_atTop_atTop (R := ℝ)) have hlim : Tendsto (fun k : ℕ ↦ log 4 / k + 3 * (log (k : ℝ) / k)) atTop (𝓝 0) := by simpa using (tendsto_const_div_atTop_nhds_zero_nat (log 4)).add (hlog.const_mul 3) apply squeeze_zero' _ _ hlim · filter_upwards [eventually_gt_atTop 0] with k hk exact div_nonneg (bernoulliSeedScale_loglog_bounds hk).1 (Nat.cast_nonneg k) · filter_upwards [eventually_gt_atTop 0] with k hk simpa only [add_div, mul_div_assoc] using div_le_div_of_nonneg_right (bernoulliSeedScale_loglog_bounds hk).2 (Nat.cast_nonneg k) theorem bernoulliSeedScale_zero_exponential_cost (P : ℕ → Finset ℕ) (hP : ∀ k p, p ∈ P k → p.Prime) {lam : ℝ} (hlam : 1 ≤ lam) (hB : ∀ᶠ k in atTop, practicalSeedPrimeUniverse (seedWindowCount (bernoulliSeedScale k)) ⊆ P k) : Tendsto (fun k : ℕ ↦ -log (practicalSeedTiltProbability (bernoulliSeedScale k) (P k) lam) / k) atTop (𝓝 0) := tendsto_neg_log_practicalSeedTiltProbability_div bernoulliSeedScale P hP hlam bernoulliSeedScale_eventually_gt_210 hB tendsto_loglog_bernoulliSeedScale_div theorem bernoulliResidueLength_exp_bound {k r : ℕ} [NeZero r] {C : ℝ} (hC : 0 ≤ C) (hr : log (2 * (r : ℝ)) ≤ exp (C * k)) : (bernoulliResidueLength r (bernoulliPhaseScale k : ℝ) : ℝ) ≤ exp (2 * (k : ℝ) ^ 3 + C * k + 3) := by have hrone : (1 : ℝ) ≤ r := by exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne r) have hlog : 0 ≤ log (2 * (r : ℝ)) := log_nonneg (by linarith) have hY : (bernoulliPhaseScale k : ℝ) ^ 2 ≤ exp (2 * (k : ℝ) ^ 3 + 2) := by calc _ ≤ exp ((k : ℝ) ^ 3 + 1) ^ 2 := pow_le_pow_left₀ (Nat.cast_nonneg _) (bernoulliPhaseScale_exp_bounds k).2 2 _ = _ := by rw [← exp_nat_mul]; congr 1; ring have hbase : (bernoulliPhaseScale k : ℝ) ^ 2 * log (2 * (r : ℝ)) ≤ exp (2 * (k : ℝ) ^ 3 + 2 + C * k) := by calc _ ≤ exp (2 * (k : ℝ) ^ 3 + 2) * exp (C * k) := mul_le_mul hY hr hlog (exp_pos _).le _ = _ := (exp_add _ _).symm have hceil : (bernoulliResidueLength r (bernoulliPhaseScale k : ℝ) : ℝ) ≤ (⌈exp (2 * (k : ℝ) ^ 3 + 2 + C * k)⌉₊ : ℝ) := by unfold bernoulliResidueLength exact_mod_cast Nat.ceil_le_ceil hbase calc _ ≤ _ := hceil _ ≤ exp (2 * (k : ℝ) ^ 3 + 2 + C * k + 1) := natCeil_exp_le_exp_add_one (by positivity) _ = _ := by congr 1; ring /-- A concrete cubic budget absorbs all ceiling errors, all coin copies, and every cardinality at most `2^(20*k)`. -/ theorem bernoulli_coefficient_cost_le_seed {k r N : ℕ} [NeZero r] {C : ℝ} (hC : 0 ≤ C) (hbudget : (C + 20) * k + 7 ≤ (k : ℝ) ^ 3) (hr : log (2 * (r : ℝ)) ≤ exp (C * k)) (hN : N ≤ 2 ^ (20 * k)) : 4 * bernoulliResidueLength r (bernoulliPhaseScale k : ℝ) * N ≤ bernoulliSeedScale k := by have he1 : (2 : ℝ) ≤ exp 1 := by linarith [Real.add_one_le_exp (1 : ℝ)] have hNexp : (N : ℝ) ≤ exp (20 * (k : ℝ)) := by calc _ ≤ (2 : ℝ) ^ (20 * k) := by exact_mod_cast hN _ ≤ exp 1 ^ (20 * k) := pow_le_pow_left₀ (by norm_num) he1 _ _ = _ := by rw [← exp_nat_mul]; congr 1; push_cast; ring have hfour : (4 : ℝ) ≤ exp 4 := by linarith [Real.add_one_le_exp (4 : ℝ)] have hL := bernoulliResidueLength_exp_bound hC hr have hR : (4 : ℝ) * bernoulliResidueLength r (bernoulliPhaseScale k : ℝ) * N ≤ bernoulliSeedScale k := by calc _ ≤ exp 4 * exp (2 * (k : ℝ) ^ 3 + C * k + 3) * exp (20 * (k : ℝ)) := mul_le_mul (mul_le_mul hfour hL (by positivity) (by positivity)) hNexp (by positivity) (by positivity) _ = exp (2 * (k : ℝ) ^ 3 + (C + 20) * k + 7) := by rw [← exp_add, ← exp_add] congr 1 ring _ ≤ exp (3 * (k : ℝ) ^ 3) := Real.exp_le_exp.mpr (by linarith) _ ≤ _ := (bernoulliSeedScale_exp_bounds k).1 exact_mod_cast hR theorem bernoulli_cubic_budget {C : ℝ} (hC : 0 ≤ C) {k : ℕ} (hk : ⌈C + 27⌉₊ ≤ k) : (C + 20) * k + 7 ≤ (k : ℝ) ^ 3 := by have hkR : C + 27 ≤ (k : ℝ) := (Nat.le_ceil _).trans (by exact_mod_cast hk) have hkone : (1 : ℝ) ≤ k := by linarith have hquad := mul_le_mul_of_nonneg_right hkR (Nat.cast_nonneg k) have hcube := mul_le_mul_of_nonneg_right hkone (sq_nonneg (k : ℝ)) nlinarith /-- The threshold depends only on `C`, uniformly over all moduli and cardinalities obeying the stated growth bounds. -/ theorem bernoulli_coefficient_cost_eventually_uniform {C : ℝ} (hC : 0 ≤ C) : ∀ᶠ k : ℕ in atTop, ∀ r N : ℕ, 0 < r → log (2 * (r : ℝ)) ≤ exp (C * k) → N ≤ 2 ^ (20 * k) → 4 * bernoulliResidueLength r (bernoulliPhaseScale k : ℝ) * N ≤ bernoulliSeedScale k := by filter_upwards [eventually_ge_atTop ⌈C + 27⌉₊] with k hk intro r N hr hlog hN let : NeZero r := ⟨hr.ne'⟩ exact bernoulli_coefficient_cost_le_seed hC (bernoulli_cubic_budget hC hk) hlog hN end Erdos859Verification end /- Inlined development module: FiniteBallotCost.lean -/ section /- Uniform occupancy ballot probability and its exact exponential cost. -/ open Finset Real namespace Erdos859Verification def occupancyCount {n : ℕ} (x : Fin n → Fin n) (j : Fin n) : ℕ := ∑ i, if x i = j then 1 else 0 theorem sum_occupancyCount {n : ℕ} (x : Fin n → Fin n) : ∑ j, occupancyCount x j = n := by unfold occupancyCount rw [sum_comm] simp theorem occupancyCount_prefix {n k : ℕ} (x : Fin n → Fin n) : (∑ j : Fin n with j.val < k, occupancyCount x j) = (univ.filter (fun i : Fin n ↦ (x i).val < k)).card := by unfold occupancyCount rw [sum_comm] simp theorem occupancy_ballot_iff {n : ℕ} (x : Fin n → Fin n) : CyclicBallot (occupancyCount x) ↔ ∀ k ≤ n, (univ.filter (fun i : Fin n ↦ (x i).val < k)).card ≤ k := by simp only [CyclicBallot, occupancyCount_prefix] def occupancyRotateEquiv {n : ℕ} (r : Fin n) : Equiv.Perm (Fin n → Fin n) where toFun x i := (finCycle r).symm (x i) invFun x i := finCycle r (x i) left_inv x := by funext i; exact (finCycle r).apply_symm_apply (x i) right_inv x := by funext i; exact (finCycle r).symm_apply_apply (x i) theorem occupancyCount_rotate {n : ℕ} (r : Fin n) (x : Fin n → Fin n) : occupancyCount (occupancyRotateEquiv r x) = cyclicRotate r (occupancyCount x) := by funext j simp only [occupancyCount, occupancyRotateEquiv, Equiv.coe_fn_mk, cyclicRotate, Equiv.symm_apply_eq] theorem sum_uniform_occupancy_rotation {n : ℕ} (r : Fin n) (F : (Fin n → Fin n) → ℝ) : (∑ x, F (occupancyRotateEquiv r x)) = ∑ x, F x := Equiv.sum_comp (occupancyRotateEquiv r) F noncomputable def uniformOccupancyBallotProbability (n : ℕ) : ℝ := ((univ.filter (fun x : Fin n → Fin n ↦ CyclicBallot (occupancyCount x))).card : ℝ) / (n : ℝ) ^ n /-- Independent uniform marks in `n` ordered cells obey every upper prefix barrier with probability at least `1/n`. -/ theorem uniform_occupancy_ballot_probability_lower {n : ℕ} (hn : 0 < n) : 1 / (n : ℝ) ≤ uniformOccupancyBallotProbability n := by classical have h := weighted_permutation_cover (univ : Finset (Fin n → Fin n)) occupancyRotateEquiv (fun _ ↦ 1) (fun x ↦ CyclicBallot (occupancyCount x)) (fun _ _ ↦ by simp) (fun _ _ ↦ zero_le_one) (fun _ _ _ ↦ rfl) ?_ · have hnR : (0 : ℝ) < n := by exact_mod_cast hn have hpow : (0 : ℝ) < (n : ℝ) ^ n := pow_pos hnR n apply (div_le_div_iff₀ hnR hpow).mpr simpa only [uniformOccupancyBallotProbability, one_mul, mul_one, mul_comm] using (show (n : ℝ) ^ n ≤ n * ((univ.filter (fun x : Fin n → Fin n ↦ CyclicBallot (occupancyCount x))).card : ℝ) by simpa using h) · intro x _ obtain ⟨r, hr⟩ := exists_cyclic_ballot hn (occupancyCount x) (sum_occupancyCount x) exact ⟨r, by rw [occupancyCount_rotate]; exact hr⟩ /-- Elementary integral-quality upper bound for a factorial, proved by induction using the logarithmic tangent inequality. -/ theorem log_factorial_upper_ballot {n : ℕ} (hn : 0 < n) : log (n.factorial : ℝ) ≤ ((n : ℝ) + 1) * log n - n + 1 := by induction n with | zero => omega | succ n ih => by_cases hn0 : n = 0 · subst n; norm_num · have hn : 0 < n := Nat.pos_of_ne_zero hn0 have hnR : (0 : ℝ) < n := by exact_mod_cast hn have hn1 : (0 : ℝ) < (n : ℝ) + 1 := by positivity have hprev := ih hn have hlog := one_sub_inv_le_log_of_pos (div_pos hn1 hnR) rw [log_div hn1.ne' hnR.ne'] at hlog have hstep : 1 ≤ ((n : ℝ) + 1) * (log ((n : ℝ) + 1) - log n) := by have hm := mul_le_mul_of_nonneg_left hlog hn1.le have he : ((n : ℝ) + 1) * (1 - (((n : ℝ) + 1) / n)⁻¹) = 1 := by field_simp ring rwa [he] at hm rw [Nat.factorial_succ, Nat.cast_mul, log_mul (by positivity) (by exact_mod_cast Nat.factorial_ne_zero n)] push_cast nlinarith /-- Exact Cramer rate; the elementary ballot and factorial losses are bounded by the explicit polynomial `exp(1) * n^2`. -/ theorem poisson_ballot_cost_lower {theta : ℝ} (htheta : 0 < theta) {n : ℕ} (hn : 0 < n) : exp (-(n : ℝ) * (theta - 1 - log theta)) / (exp 1 * (n : ℝ) ^ 2) ≤ exp (-theta * n) * (theta * n) ^ n / n.factorial / n := by have hnR : (0 : ℝ) < n := by exact_mod_cast hn have hnfac : (0 : ℝ) < n.factorial := by exact_mod_cast Nat.factorial_pos n have hleft : 0 < exp (-(n : ℝ) * (theta - 1 - log theta)) / (exp 1 * (n : ℝ) ^ 2) := by positivity have hright : 0 < exp (-theta * n) * (theta * n) ^ n / n.factorial / n := by positivity apply (log_le_log_iff hleft hright).mp rw [log_div (exp_pos _).ne' (by positivity), log_mul (exp_pos _).ne' (pow_pos hnR 2).ne', log_exp, log_exp, log_pow, log_div (by positivity) hnR.ne', log_div (by positivity) hnfac.ne', log_mul (exp_pos _).ne' (pow_pos (mul_pos htheta hnR) n).ne', log_exp, log_pow, log_mul htheta.ne' hnR.ne'] have hfac := log_factorial_upper_ballot hn push_cast nlinarith theorem uniform_occupancy_ballot_exact_rate {theta : ℝ} (htheta : 0 < theta) {n : ℕ} (hn : 0 < n) : exp (-(n : ℝ) * (theta - 1 - log theta)) / (exp 1 * (n : ℝ) ^ 2) ≤ (exp (-theta * n) * (theta * n) ^ n / n.factorial) * uniformOccupancyBallotProbability n := by calc _ ≤ exp (-theta * n) * (theta * n) ^ n / n.factorial / n := poisson_ballot_cost_lower htheta hn _ = (exp (-theta * n) * (theta * n) ^ n / n.factorial) * (1 / n) := by ring _ ≤ _ := mul_le_mul_of_nonneg_left (uniform_occupancy_ballot_probability_lower hn) (by positivity) /-- The same rate written entirely as a finite sum over ordered marks. The weight is the total-count mass times the uniform conditional mark law. -/ theorem finite_occupancy_ballot_cost_lower {theta : ℝ} (htheta : 0 < theta) {n : ℕ} (hn : 0 < n) : exp (-(n : ℝ) * (theta - 1 - log theta)) / (exp 1 * (n : ℝ) ^ 2) ≤ ∑ x : Fin n → Fin n with CyclicBallot (occupancyCount x), exp (-theta * n) * theta ^ n / n.factorial := by have hnR : (n : ℝ) ≠ 0 := by exact_mod_cast hn.ne' have hfac : (n.factorial : ℝ) ≠ 0 := by exact_mod_cast Nat.factorial_ne_zero n convert uniform_occupancy_ballot_exact_rate htheta hn using 1 rw [uniformOccupancyBallotProbability, sum_const, nsmul_eq_mul, mul_pow] field_simp theorem finite_occupancy_ballot_cost_lower_mul {lam a : ℝ} (hlam : 0 < lam) (ha : 0 < a) {n : ℕ} (hn : 0 < n) : exp (-(n : ℝ) * (lam * a - 1 - log (lam * a))) / (exp 1 * (n : ℝ) ^ 2) ≤ ∑ x : Fin n → Fin n with CyclicBallot (occupancyCount x), exp (-(lam * a) * n) * (lam * a) ^ n / n.factorial := finite_occupancy_ballot_cost_lower (mul_pos hlam ha) hn end Erdos859Verification end /- Inlined development module: FiniteBallotBins.lean -/ section /- Exact bin pushforward for independent finite marks and a ballot lower bound. -/ open Finset Real namespace Erdos859Verification noncomputable def finiteBinMass {α β : Type*} [Fintype α] [DecidableEq β] (weight : α → ℝ) (bin : α → β) (j : β) : ℝ := ∑ p with bin p = j, weight p /-- Each label tuple has precisely the product of its bin masses as its total preimage weight. No normalization or positivity is required. -/ theorem finite_bin_tuple_fiber {ι α β : Type*} [Fintype ι] [DecidableEq ι] [Fintype α] [Fintype β] [DecidableEq β] (weight : α → ℝ) (bin : α → β) (y : ι → β) : (∑ x : ι → α with (fun i ↦ bin (x i)) = y, ∏ i, weight (x i)) = ∏ i, finiteBinMass weight bin (y i) := by classical simp only [finiteBinMass, sum_filter] rw [Fintype.prod_sum] apply sum_congr rfl intro x _ rw [Fintype.prod_ite_zero] simp only [funext_iff] /-- Exact pushforward of the product law through a finite binning map, valid for every event on ordered labels. -/ theorem finite_bin_event_pushforward {ι α β : Type*} [Fintype ι] [DecidableEq ι] [Fintype α] [Fintype β] [DecidableEq β] (weight : α → ℝ) (bin : α → β) (Good : (ι → β) → Prop) [DecidablePred Good] : (∑ x : ι → α with Good (fun i ↦ bin (x i)), ∏ i, weight (x i)) = ∑ y : ι → β with Good y, ∏ i, finiteBinMass weight bin (y i) := by classical simp_rw [← finite_bin_tuple_fiber] symm simpa only [mem_filter, mem_univ, true_and] using sum_fiberwise_eq_sum_filter (univ : Finset (ι → α)) (univ.filter Good) (fun x i ↦ bin (x i)) (fun x ↦ ∏ i, weight (x i)) theorem finite_bin_ballot_pushforward {n : ℕ} {α : Type*} [Fintype α] (weight : α → ℝ) (bin : α → Fin n) : (∑ x : Fin n → α with CyclicBallot (occupancyCount (fun i ↦ bin (x i))), ∏ i, weight (x i)) = ∑ y : Fin n → Fin n with CyclicBallot (occupancyCount y), ∏ i, finiteBinMass weight bin (y i) := finite_bin_event_pushforward weight bin (fun y ↦ CyclicBallot (occupancyCount y)) /-- A lower mass in each ordered bin transfers the uniform occupancy ballot count to arbitrary independent mark weights. -/ theorem finite_bin_ballot_weight_lower {n : ℕ} (hn : 0 < n) {α : Type*} [Fintype α] (weight : α → ℝ) (bin : α → Fin n) {a : ℝ} (ha : 0 ≤ a) (hbin : ∀ j, a ≤ finiteBinMass weight bin j) : ((n : ℝ) * a) ^ n / n ≤ ∑ x : Fin n → α with CyclicBallot (occupancyCount (fun i ↦ bin (x i))), ∏ i, weight (x i) := by classical have hnR : (0 : ℝ) < n := by exact_mod_cast hn have hpow : (0 : ℝ) < (n : ℝ) ^ n := pow_pos hnR n have hprob := uniform_occupancy_ballot_probability_lower hn unfold uniformOccupancyBallotProbability at hprob have hcard : (n : ℝ) ^ n / n ≤ ((univ.filter (fun y : Fin n → Fin n ↦ CyclicBallot (occupancyCount y))).card : ℝ) := by apply (div_le_iff₀ hnR).mpr simpa only [one_mul] using (div_le_div_iff₀ hnR hpow).mp hprob rw [finite_bin_ballot_pushforward] calc _ = ((n : ℝ) ^ n / n) * a ^ n := by rw [mul_pow]; ring _ ≤ ((univ.filter (fun y : Fin n → Fin n ↦ CyclicBallot (occupancyCount y))).card : ℝ) * a ^ n := mul_le_mul_of_nonneg_right hcard (pow_nonneg ha n) _ = ∑ y : Fin n → Fin n with CyclicBallot (occupancyCount y), a ^ n := by simp _ ≤ _ := by apply sum_le_sum intro y _ have h := prod_le_prod (s := (univ : Finset (Fin n))) (f := fun _ ↦ a) (g := fun i ↦ finiteBinMass weight bin (y i)) (fun _ _ ↦ ha) (fun i _ ↦ hbin (y i)) simpa using h theorem finite_bin_ballot_probability_bounds {n : ℕ} (hn : 0 < n) {α : Type*} [Fintype α] (weight : α → ℝ) (bin : α → Fin n) (hweight : ∀ p, 0 ≤ weight p) (hnorm : ∑ p, weight p = 1) {a : ℝ} (ha : 0 < a) (hbin : ∀ j, a ≤ finiteBinMass weight bin j) : ((n : ℝ) * a) ^ n / n ≤ (∑ x : Fin n → α with CyclicBallot (occupancyCount (fun i ↦ bin (x i))), ∏ i, weight (x i)) ∧ (∑ x : Fin n → α with CyclicBallot (occupancyCount (fun i ↦ bin (x i))), ∏ i, weight (x i)) ≤ 1 := by classical refine ⟨finite_bin_ballot_weight_lower hn weight bin ha.le hbin, ?_⟩ calc _ ≤ ∑ x : Fin n → α, ∏ i, weight (x i) := sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun x _ _ ↦ prod_nonneg (fun i _ ↦ hweight (x i))) _ = ∏ _i : Fin n, ∑ p, weight p := (Fintype.prod_sum (fun (_ : Fin n) p ↦ weight p)).symm _ = 1 := by simp only [hnorm, prod_const_one] end Erdos859Verification end /- Inlined development module: FiniteBallotMonotoneBins.lean -/ section /- Ballot occupancy tuples favor increasing bin weights. -/ open Finset Real namespace Erdos859Verification /-- The ballot prefix barrier forces the sorted `i`-th label to be at least `i`. Multiplicities are retained by the sorting permutation. -/ theorem ballot_sorted_label_ge {n : ℕ} (x : Fin n → Fin n) (hx : CyclicBallot (occupancyCount x)) (i : Fin n) : i ≤ x (Tuple.sort x i) := by by_contra h have hlt : x (Tuple.sort x i) < i := lt_of_not_ge h have hcard := (Tuple.lt_card_lt_iff_apply_lt_of_monotone (j := i) (a := i) (Tuple.monotone_sort x)).mpr hlt have hperm : (univ.filter (fun j ↦ x (Tuple.sort x j) < i)).card = (univ.filter (fun j ↦ x j < i)).card := by simpa using Equiv.sum_comp (Tuple.sort x) (fun j ↦ if x j < i then (1 : ℕ) else 0) have hprefix := (occupancy_ballot_iff x).mp hx i.val i.isLt.le change i.val < (univ.filter (fun j ↦ x (Tuple.sort x j) < i)).card at hcard rw [hperm] at hcard simp only [Fin.lt_def] at hcard omega /-- Every ballot assignment has product weight at least one copy of each ordered bin's weight, when those weights are nonnegative and increasing. -/ theorem ballot_monotone_product_lower {n : ℕ} (x : Fin n → Fin n) (hx : CyclicBallot (occupancyCount x)) (a : Fin n → ℝ) (ha : ∀ j, 0 ≤ a j) (hmono : Monotone a) : (∏ j, a j) ≤ ∏ i, a (x i) := by calc _ ≤ ∏ i, a (x (Tuple.sort x i)) := prod_le_prod (fun j _ ↦ ha j) (fun i _ ↦ hmono (ballot_sorted_label_ge x hx i)) _ = _ := Equiv.prod_comp (Tuple.sort x) (fun i ↦ a (x i)) /-- The uniform ballot count remains available with different increasing bin lower bounds; no normalization or equal-intensity partition is assumed. -/ theorem finite_bin_ballot_monotone_weight_lower {n : ℕ} (hn : 0 < n) {α : Type*} [Fintype α] (weight : α → ℝ) (bin : α → Fin n) (a : Fin n → ℝ) (ha : ∀ j, 0 ≤ a j) (hmono : Monotone a) (hbin : ∀ j, a j ≤ finiteBinMass weight bin j) : ((n : ℝ) ^ n / n) * (∏ j, a j) ≤ ∑ x : Fin n → α with CyclicBallot (occupancyCount (fun i ↦ bin (x i))), ∏ i, weight (x i) := by classical have hnR : (0 : ℝ) < n := by exact_mod_cast hn have hpow : (0 : ℝ) < (n : ℝ) ^ n := pow_pos hnR n have hprob := uniform_occupancy_ballot_probability_lower hn unfold uniformOccupancyBallotProbability at hprob have hcard : (n : ℝ) ^ n / n ≤ ((univ.filter (fun y : Fin n → Fin n ↦ CyclicBallot (occupancyCount y))).card : ℝ) := by apply (div_le_iff₀ hnR).mpr simpa only [one_mul] using (div_le_div_iff₀ hnR hpow).mp hprob rw [finite_bin_ballot_pushforward] calc _ ≤ ((univ.filter (fun y : Fin n → Fin n ↦ CyclicBallot (occupancyCount y))).card : ℝ) * (∏ j, a j) := mul_le_mul_of_nonneg_right hcard (prod_nonneg (fun j _ ↦ ha j)) _ = ∑ y : Fin n → Fin n with CyclicBallot (occupancyCount y), ∏ j, a j := by simp _ ≤ _ := by apply sum_le_sum intro y hy exact (ballot_monotone_product_lower y (mem_filter.mp hy).2 a ha hmono).trans (prod_le_prod (fun i _ ↦ ha (y i)) (fun i _ ↦ hbin (y i))) theorem finite_bin_ballot_monotone_probability_bounds {n : ℕ} (hn : 0 < n) {α : Type*} [Fintype α] (weight : α → ℝ) (bin : α → Fin n) (hweight : ∀ p, 0 ≤ weight p) (hnorm : ∑ p, weight p = 1) (a : Fin n → ℝ) (ha : ∀ j, 0 ≤ a j) (hmono : Monotone a) (hbin : ∀ j, a j ≤ finiteBinMass weight bin j) : ((n : ℝ) ^ n / n) * (∏ j, a j) ≤ (∑ x : Fin n → α with CyclicBallot (occupancyCount (fun i ↦ bin (x i))), ∏ i, weight (x i)) ∧ (∑ x : Fin n → α with CyclicBallot (occupancyCount (fun i ↦ bin (x i))), ∏ i, weight (x i)) ≤ 1 := by classical refine ⟨finite_bin_ballot_monotone_weight_lower hn weight bin a ha hmono hbin, ?_⟩ calc _ ≤ ∑ x : Fin n → α, ∏ i, weight (x i) := sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun x _ _ ↦ prod_nonneg (fun i _ ↦ hweight (x i))) _ = ∏ _i : Fin n, ∑ p, weight p := (Fintype.prod_sum (fun (_ : Fin n) p ↦ weight p)).symm _ = 1 := by simp only [hnorm, prod_const_one] end Erdos859Verification end /- Inlined development module: VirtualCoreBins.lean -/ section /- Shifted logarithmic bins and their subexponential product loss. -/ open Finset Real namespace Erdos859Verification noncomputable def virtualCoreBin (A B : ℝ) (j : ℕ) : ℝ := log ((A + B * 2 ^ (j + 1)) / (A + B * 2 ^ j)) theorem log_one_add_chord {x : ℝ} (hx : 0 ≤ x) (hx1 : x ≤ 1) : x * log 2 ≤ log (1 + x) := by have h := strictConcaveOn_log_Ioi.concaveOn.2 (show (1 : ℝ) ∈ Set.Ioi 0 by norm_num) (show (2 : ℝ) ∈ Set.Ioi 0 by norm_num) (show 0 ≤ 1 - x by linarith) hx (by ring : 1 - x + x = 1) simp only [smul_eq_mul, log_one, mul_zero, zero_add] at h have he : (1 - x) * 1 + x * 2 = 1 + x := by ring rw [he] at h exact h theorem virtualCoreBin_eq_normalized {A B : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (j : ℕ) : virtualCoreBin A B j = log (1 + 1 / (1 + (A / B) / (2 : ℝ) ^ j)) := by have hpow : (0 : ℝ) < 2 ^ j := by positivity have hden : 0 < A + B * 2 ^ j := by positivity have hden' : 0 < 1 + (A / B) / (2 : ℝ) ^ j := by positivity unfold virtualCoreBin congr 1 rw [pow_succ] field_simp ring theorem virtualCoreBin_lower {A B : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (j : ℕ) : log 2 / (1 + (A / B) / (2 : ℝ) ^ j) ≤ virtualCoreBin A B j := by rw [virtualCoreBin_eq_normalized hA hB] have hd : 1 ≤ 1 + (A / B) / (2 : ℝ) ^ j := by have h : 0 ≤ (A / B) / (2 : ℝ) ^ j := by positivity linarith have hx : 0 ≤ 1 / (1 + (A / B) / (2 : ℝ) ^ j) := by positivity have hx1 : 1 / (1 + (A / B) / (2 : ℝ) ^ j) ≤ 1 := (div_le_one (by positivity)).mpr hd simpa only [one_div, div_eq_mul_inv, mul_comm, one_mul, mul_one] using log_one_add_chord hx hx1 theorem virtualCoreBin_pos {A B : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (j : ℕ) : 0 < virtualCoreBin A B j := (div_pos (log_pos (by norm_num : (1 : ℝ) < 2)) (by positivity)).trans_le (virtualCoreBin_lower hA hB j) theorem virtualCoreBin_monotone {A B : ℝ} (hA : 0 ≤ A) (hB : 0 < B) : Monotone (virtualCoreBin A B) := by intro i j hij rw [virtualCoreBin_eq_normalized hA hB, virtualCoreBin_eq_normalized hA hB] have hpow : (2 : ℝ) ^ i ≤ 2 ^ j := pow_le_pow_right₀ (by norm_num) hij have hfrac : (A / B) / (2 : ℝ) ^ j ≤ (A / B) / (2 : ℝ) ^ i := div_le_div_of_nonneg_left (div_nonneg hA hB.le) (by positivity) hpow have hinv : 1 / (1 + (A / B) / (2 : ℝ) ^ i) ≤ 1 / (1 + (A / B) / (2 : ℝ) ^ j) := one_div_le_one_div_of_le (by positivity) (by linarith) exact log_le_log (by positivity) (by linarith) theorem virtual_core_loss_head {K : ℝ} (hK : 0 ≤ K) (m : ℕ) : (∑ j ∈ range m, log (1 + K / (2 : ℝ) ^ j)) ≤ m * log (1 + K) := by calc _ ≤ ∑ _j ∈ range m, log (1 + K) := by apply sum_le_sum intro j _ apply log_le_log (by positivity) have hp : (1 : ℝ) ≤ 2 ^ j := one_le_pow₀ (by norm_num) have h : K / (2 : ℝ) ^ j ≤ K := by apply (div_le_iff₀ (by positivity)).mpr nlinarith linarith _ = _ := by simp theorem virtual_core_loss_tail {K : ℝ} (hK : 0 ≤ K) {J : ℕ} (hKJ : K ≤ (2 : ℝ) ^ J) (m : ℕ) : (∑ j ∈ range m, log (1 + K / (2 : ℝ) ^ (J + j))) ≤ 2 := by have hgeom : (∑ j ∈ range m, ((1 : ℝ) / 2) ^ j) ≤ 2 := by have h := geom_sum_Ico_le_of_lt_one (m := 0) (n := m) (by norm_num : (0 : ℝ) ≤ 1 / 2) (by norm_num : (1 : ℝ) / 2 < 1) norm_num at h ⊢ exact h apply le_trans _ hgeom apply sum_le_sum intro j _ have hlog := log_le_sub_one_of_pos (show 0 < 1 + K / (2 : ℝ) ^ (J + j) by positivity) have hratio : K / (2 : ℝ) ^ (J + j) ≤ ((1 : ℝ) / 2) ^ j := by calc _ ≤ (2 : ℝ) ^ J / 2 ^ (J + j) := div_le_div_of_nonneg_right hKJ (by positivity) _ = _ := by rw [pow_add, div_mul_eq_div_div, div_self (by positivity), div_pow, one_pow] linarith /-- Only the first `J` bins can have a substantial loss; the remaining logarithmic losses have a geometric total at most two. -/ theorem virtual_core_log_loss_bound {K : ℝ} (hK : 0 ≤ K) {J : ℕ} (hKJ : K ≤ (2 : ℝ) ^ J) (n : ℕ) : (∑ j ∈ range n, log (1 + K / (2 : ℝ) ^ j)) ≤ J * log (1 + K) + 2 := by by_cases hn : n ≤ J · have hlog : 0 ≤ log (1 + K) := log_nonneg (by linarith) have hnj : (n : ℝ) ≤ J := by exact_mod_cast hn have h := virtual_core_loss_head hK n have hm := mul_le_mul_of_nonneg_right hnj hlog linarith · have hJn : J ≤ n := by omega rw [show n = J + (n - J) by omega, sum_range_add] exact add_le_add (virtual_core_loss_head hK J) (virtual_core_loss_tail hK hKJ (n - J)) theorem virtual_core_loss_product_bound {K : ℝ} (hK : 0 ≤ K) {J : ℕ} (hKJ : K ≤ (2 : ℝ) ^ J) (n : ℕ) : (∏ j ∈ range n, (1 + K / (2 : ℝ) ^ j)) ≤ exp (J * log (1 + K) + 2) := by apply (log_le_log_iff (prod_pos (fun j _ ↦ by positivity)) (exp_pos _)).mp rw [log_prod (fun j _ ↦ by positivity), log_exp] exact virtual_core_log_loss_bound hK hKJ n /-- Product lower bound with no exponential-in-`A/B` penalty. -/ theorem virtualCoreBin_product_lower {A B : ℝ} (hA : 0 ≤ A) (hB : 0 < B) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) (n : ℕ) : log 2 ^ n * exp (-(J : ℝ) * log (1 + A / B) - 2) ≤ ∏ j ∈ range n, virtualCoreBin A B j := by have hK : 0 ≤ A / B := div_nonneg hA hB.le have hprod : 0 < ∏ j ∈ range n, (1 + (A / B) / (2 : ℝ) ^ j) := prod_pos (fun j _ ↦ by positivity) have hlog : 0 ≤ log (2 : ℝ) := log_nonneg (by norm_num) calc _ = log 2 ^ n / exp (J * log (1 + A / B) + 2) := by rw [show -(J : ℝ) * log (1 + A / B) - 2 = -(J * log (1 + A / B) + 2) by ring, exp_neg] rfl _ ≤ log 2 ^ n / (∏ j ∈ range n, (1 + (A / B) / (2 : ℝ) ^ j)) := div_le_div_of_nonneg_left (pow_nonneg hlog n) hprod (virtual_core_loss_product_bound hK hAB n) _ = ∏ j ∈ range n, log 2 / (1 + (A / B) / (2 : ℝ) ^ j) := by rw [prod_div_distrib, prod_const, card_range] _ ≤ _ := prod_le_prod (fun j _ ↦ div_nonneg hlog (by positivity)) (fun j _ ↦ virtualCoreBin_lower hA hB j) /-- Apply the product correction directly to the finite weighted ballot law. The premise concerns the actual masses of the displayed bins. -/ theorem virtual_core_ballot_weight_lower {n : ℕ} (hn : 0 < n) {α : Type*} [Fintype α] (weight : α → ℝ) (bin : α → Fin n) {A B lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hlam : 0 ≤ lam) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) (hbin : ∀ j, lam * virtualCoreBin A B j.val ≤ finiteBinMass weight bin j) : ((n : ℝ) ^ n / n) * (lam * log 2) ^ n * exp (-(J : ℝ) * log (1 + A / B) - 2) ≤ ∑ x : Fin n → α with CyclicBallot (occupancyCount (fun i ↦ bin (x i))), ∏ i, weight (x i) := by have hprod : (lam * log 2) ^ n * exp (-(J : ℝ) * log (1 + A / B) - 2) ≤ ∏ j : Fin n, lam * virtualCoreBin A B j.val := by rw [prod_mul_distrib, prod_const, card_univ, Fintype.card_fin, Fin.prod_univ_eq_prod_range (virtualCoreBin A B) n, mul_pow] simpa only [mul_assoc] using mul_le_mul_of_nonneg_left (virtualCoreBin_product_lower hA hB hAB n) (pow_nonneg hlam n) have hballot := finite_bin_ballot_monotone_weight_lower hn weight bin (fun j ↦ lam * virtualCoreBin A B j.val) (fun j ↦ mul_nonneg hlam (virtualCoreBin_pos hA hB j.val).le) (fun i j hij ↦ mul_le_mul_of_nonneg_left (virtualCoreBin_monotone hA hB hij) hlam) hbin apply le_trans ?_ hballot simpa only [mul_assoc] using mul_le_mul_of_nonneg_left hprod (by positivity : 0 ≤ (n : ℝ) ^ n / n) end Erdos859Verification end /- Inlined development module: PrimeLogOddsMertens.lean -/ section /- Uniform weak Mertens estimates for normalized logarithmic prime odds. -/ namespace Erdos859Verification open Finset Real /-- The normalized logarithmic intensity differs positively from `1 / p`. -/ theorem primeLogOddsIntensity_normalized_correction {lam : ℝ} {p : ℕ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hp : p.Prime) : 0 ≤ primeLogOddsIntensity lam p / lam - 1 / (p : ℝ) ∧ primeLogOddsIntensity lam p / lam - 1 / (p : ℝ) ≤ 1 / ((p : ℝ) * ((p : ℝ) - 1)) := by have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le have hp0 : (0 : ℝ) < p := by linarith have hd : 0 < (p : ℝ) - 1 := by linarith have hl : 0 < lam := by linarith have hsharp := le_log_one_add_of_nonneg (div_nonneg hl.le hd.le) have hden : 0 < 2 * (p : ℝ) + lam - 2 := by linarith have hid : 2 * (lam / ((p : ℝ) - 1)) / (lam / ((p : ℝ) - 1) + 2) = 2 * lam / (2 * (p : ℝ) + lam - 2) := by field_simp ring rw [hid] at hsharp have hlow : lam / (p : ℝ) ≤ primeLogOddsIntensity lam p := by apply le_trans _ hsharp apply (div_le_div_iff₀ hp0 hden).mpr nlinarith have hu : primeLogOddsIntensity lam p ≤ lam / ((p : ℝ) - 1) := by have h := log_le_sub_one_of_pos (by positivity : 0 < 1 + lam / ((p : ℝ) - 1)) unfold primeLogOddsIntensity linarith constructor · apply sub_nonneg.mpr apply (le_div_iff₀ hl).mpr simpa only [one_div_mul_eq_div] using hlow · calc _ ≤ (lam / ((p : ℝ) - 1)) / lam - 1 / (p : ℝ) := sub_le_sub_right (div_le_div_of_nonneg_right hu hl.le) _ _ = _ := by field_simp; ring /-- A nonnegative sequence bounded by the telescoping reciprocal kernel has a quantitative finite tail estimate. -/ theorem sum_reciprocal_correction_tail_le {f : ℕ → ℝ} (hf : ∀ n, 2 ≤ n → f n ≤ 1 / ((n : ℝ) * ((n : ℝ) - 1))) {N : ℕ} (hN : 1 ≤ N) (m : ℕ) : (∑ n ∈ range m, f (n + (N + 1))) ≤ 1 / (N : ℝ) - 1 / ((N : ℝ) + m) := by induction m with | zero => simp | succ m ih => rw [sum_range_succ] have hNm : 0 < (N : ℝ) + m := by exact_mod_cast (by omega : 0 < N + m) have hnext := hf (m + (N + 1)) (by omega) have hid : 1 / (((m + (N + 1) : ℕ) : ℝ) * (((m + (N + 1) : ℕ) : ℝ) - 1)) = 1 / ((N : ℝ) + m) - 1 / ((N : ℝ) + (m + 1)) := by calc _ = 1 / (((N : ℝ) + m + 1) * ((N : ℝ) + m)) := by congr 1 push_cast ring _ = _ := by field_simp [hNm.ne', (by linarith : (N : ℝ) + m + 1 ≠ 0)] ring rw [hid] at hnext push_cast linarith theorem summable_reciprocal_correction {f : ℕ → ℝ} (hf0 : ∀ n, 0 ≤ f n) (hf : ∀ n, 2 ≤ n → f n ≤ 1 / ((n : ℝ) * ((n : ℝ) - 1))) : Summable f := by have hs : Summable (fun n ↦ f (n + 2)) := by apply summable_of_sum_range_le (c := 1) (fun n ↦ hf0 _) intro m have h := sum_reciprocal_correction_tail_le hf (N := 1) (by omega) m norm_num only [Nat.cast_one, one_div_one] at h exact h.trans (sub_le_self _ (by positivity)) exact (summable_nat_add_iff 2).mp hs theorem tsum_reciprocal_correction_tail_le {f : ℕ → ℝ} (hf0 : ∀ n, 0 ≤ f n) (hf : ∀ n, 2 ≤ n → f n ≤ 1 / ((n : ℝ) * ((n : ℝ) - 1))) {N : ℕ} (hN : 1 ≤ N) : (∑' n : ℕ, f (n + (N + 1))) ≤ 1 / (N : ℝ) := by apply Real.tsum_le_of_sum_range_le (fun n ↦ hf0 _) intro m exact (sum_reciprocal_correction_tail_le hf hN m).trans (sub_le_self _ (by positivity)) noncomputable def primeLogOddsCorrection (lam : ℝ) (p : ℕ) : ℝ := if p.Prime then primeLogOddsIntensity lam p / lam - 1 / (p : ℝ) else 0 theorem primeLogOddsCorrection_bounds {lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) : (∀ p, 0 ≤ primeLogOddsCorrection lam p) ∧ ∀ p, 2 ≤ p → primeLogOddsCorrection lam p ≤ 1 / ((p : ℝ) * ((p : ℝ) - 1)) := by constructor · intro p by_cases hp : p.Prime · simpa only [primeLogOddsCorrection, if_pos hp] using (primeLogOddsIntensity_normalized_correction hlam hlam2 hp).1 · simp only [primeLogOddsCorrection, if_neg hp, le_refl] · intro p hp2 by_cases hp : p.Prime · simpa only [primeLogOddsCorrection, if_pos hp] using (primeLogOddsIntensity_normalized_correction hlam hlam2 hp).2 · simp only [primeLogOddsCorrection, if_neg hp] have hp2' : (2 : ℝ) ≤ p := by exact_mod_cast hp2 exact one_div_nonneg.mpr (mul_nonneg (Nat.cast_nonneg p) (by linarith)) theorem summable_primeLogOddsCorrection {lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) : Summable (primeLogOddsCorrection lam) := summable_reciprocal_correction (primeLogOddsCorrection_bounds hlam hlam2).1 (primeLogOddsCorrection_bounds hlam hlam2).2 noncomputable def primeLogOddsMertensConstant (lam : ℝ) : ℝ := PrimeMertens.M + ∑' p : ℕ, primeLogOddsCorrection lam p noncomputable def primeLogOddsErrorConstant : ℝ := mertensErrorConstant + 2 theorem primeLogOddsErrorConstant_pos : 0 < primeLogOddsErrorConstant := by unfold primeLogOddsErrorConstant linarith [mertensErrorConstant_pos] theorem primeLogOddsCorrection_partial_tail {lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) {N : ℕ} (hN : 1 ≤ N) : |(∑ p ∈ range (N + 1), primeLogOddsCorrection lam p) - ∑' p : ℕ, primeLogOddsCorrection lam p| ≤ 1 / (N : ℝ) := by have hb := primeLogOddsCorrection_bounds hlam hlam2 have hs := (summable_primeLogOddsCorrection hlam hlam2).sum_add_tsum_nat_add (N + 1) have htail := tsum_reciprocal_correction_tail_le hb.1 hb.2 hN have ht0 : 0 ≤ ∑' n : ℕ, primeLogOddsCorrection lam (n + (N + 1)) := tsum_nonneg (fun n ↦ hb.1 _) have hid : (∑ p ∈ range (N + 1), primeLogOddsCorrection lam p) - ∑' p : ℕ, primeLogOddsCorrection lam p = -(∑' n : ℕ, primeLogOddsCorrection lam (n + (N + 1))) := by linarith rw [hid, abs_neg, abs_of_nonneg ht0] exact htail theorem sum_Ioc_zero_eq_sum_range_of_zero {f : ℕ → ℝ} (hf : f 0 = 0) (N : ℕ) : (∑ p ∈ Ioc 0 N, f p) = ∑ p ∈ range (N + 1), f p := by apply sum_subset · intro p hp simp only [Finset.mem_Ioc, Finset.mem_range] at hp ⊢ omega · intro p hp hnot have hpN := Finset.mem_range.mp hp have hp0 : p = 0 := by simp only [Finset.mem_Ioc] at hnot omega simpa only [hp0] using hf noncomputable def primeNormalizedLogOddsSum (lam x : ℝ) : ℝ := ∑ p ∈ (Ioc 0 ⌊x⌋₊).filter Nat.Prime, primeLogOddsIntensity lam p / lam theorem primeNormalizedLogOddsSum_eq (lam x : ℝ) : primeNormalizedLogOddsSum lam x = primeReciprocalSum x + ∑ p ∈ range (⌊x⌋₊ + 1), primeLogOddsCorrection lam p := by have hr : primeReciprocalSum x = ∑ p ∈ range (⌊x⌋₊ + 1), if p.Prime then 1 / (p : ℝ) else 0 := by unfold primeReciprocalSum rw [sum_filter] exact sum_Ioc_zero_eq_sum_range_of_zero (by norm_num) _ have ho : primeNormalizedLogOddsSum lam x = ∑ p ∈ range (⌊x⌋₊ + 1), if p.Prime then primeLogOddsIntensity lam p / lam else 0 := by unfold primeNormalizedLogOddsSum rw [sum_filter] exact sum_Ioc_zero_eq_sum_range_of_zero (by norm_num) _ rw [hr, ho, ← sum_add_distrib] apply sum_congr rfl intro p _ by_cases hp : p.Prime · simp only [primeLogOddsCorrection, if_pos hp] ring · simp only [primeLogOddsCorrection, if_neg hp, add_zero] /-- The weak Mertens constant is uniform throughout the tilt interval `[1,2]`. -/ theorem primeNormalizedLogOddsSum_estimate {lam v : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) : |primeNormalizedLogOddsSum lam (exp v) - log v - primeLogOddsMertensConstant lam| ≤ primeLogOddsErrorConstant / v := by have hv0 : 0 < v := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv have hev : 2 ≤ exp v := (log_le_iff_le_exp (by norm_num : (0 : ℝ) < 2)).mp hv have hf := Nat.div_two_lt_floor (by linarith : 1 ≤ exp v) have hN0 : (0 : ℝ) < ⌊exp v⌋₊ := by linarith [exp_pos v] have hN : 1 ≤ ⌊exp v⌋₊ := by have : 0 < ⌊exp v⌋₊ := by exact_mod_cast hN0 omega have htail := primeLogOddsCorrection_partial_tail hlam hlam2 hN have hrec := primeReciprocalSum_estimate hev rw [log_exp] at hrec have hscale : 1 / (⌊exp v⌋₊ : ℝ) ≤ 2 / v := by apply (div_le_div_iff₀ hN0 hv0).mpr linarith [add_one_le_exp v] rw [primeNormalizedLogOddsSum_eq, primeLogOddsMertensConstant] have hid : primeReciprocalSum (exp v) + (∑ p ∈ range (⌊exp v⌋₊ + 1), primeLogOddsCorrection lam p) - log v - (PrimeMertens.M + ∑' p : ℕ, primeLogOddsCorrection lam p) = (primeReciprocalSum (exp v) - log v - PrimeMertens.M) + ((∑ p ∈ range (⌊exp v⌋₊ + 1), primeLogOddsCorrection lam p) - ∑' p : ℕ, primeLogOddsCorrection lam p) := by ring rw [hid] calc _ ≤ |primeReciprocalSum (exp v) - log v - PrimeMertens.M| + |(∑ p ∈ range (⌊exp v⌋₊ + 1), primeLogOddsCorrection lam p) - ∑' p : ℕ, primeLogOddsCorrection lam p| := abs_add_le _ _ _ ≤ mertensErrorConstant / v + 2 / v := add_le_add hrec (htail.trans hscale) _ = _ := by unfold primeLogOddsErrorConstant; ring noncomputable def primeNormalizedLogOddsWindowMass (lam u v : ℝ) : ℝ := ∑ p ∈ primeLogWindow u v, primeLogOddsIntensity lam p / lam theorem primeNormalizedLogOddsWindowMass_eq_sub {u v : ℝ} (huv : u ≤ v) (lam : ℝ) : primeNormalizedLogOddsWindowMass lam u v = primeNormalizedLogOddsSum lam (exp v) - primeNormalizedLogOddsSum lam (exp u) := by have h := sum_Ioc_consecutive (fun p : ℕ ↦ if p.Prime then primeLogOddsIntensity lam p / lam else 0) (Nat.zero_le ⌊exp u⌋₊) (Nat.floor_mono (exp_le_exp.mpr huv)) simp only [← sum_filter] at h unfold primeNormalizedLogOddsWindowMass primeLogWindow primeNormalizedLogOddsSum linarith theorem primeNormalizedLogOddsWindowMass_estimate {lam u v : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (huv : u ≤ v) : |primeNormalizedLogOddsWindowMass lam u v - log (v / u)| ≤ 2 * primeLogOddsErrorConstant / u := by have hu0 : 0 < u := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hu have hv0 : 0 < v := hu0.trans_le huv have heu := primeNormalizedLogOddsSum_estimate hlam hlam2 hu have hev := primeNormalizedLogOddsSum_estimate hlam hlam2 (hu.trans huv) rw [primeNormalizedLogOddsWindowMass_eq_sub huv, log_div hv0.ne' hu0.ne'] have hid : primeNormalizedLogOddsSum lam (exp v) - primeNormalizedLogOddsSum lam (exp u) - (log v - log u) = (primeNormalizedLogOddsSum lam (exp v) - log v - primeLogOddsMertensConstant lam) - (primeNormalizedLogOddsSum lam (exp u) - log u - primeLogOddsMertensConstant lam) := by ring rw [hid] calc _ ≤ |primeNormalizedLogOddsSum lam (exp v) - log v - primeLogOddsMertensConstant lam| + |primeNormalizedLogOddsSum lam (exp u) - log u - primeLogOddsMertensConstant lam| := abs_sub _ _ _ ≤ primeLogOddsErrorConstant / v + primeLogOddsErrorConstant / u := add_le_add hev heu _ ≤ primeLogOddsErrorConstant / u + primeLogOddsErrorConstant / u := add_le_add (div_le_div_of_nonneg_left primeLogOddsErrorConstant_pos.le hu0 huv) le_rfl _ = _ := by ring theorem primeNormalizedLogOddsWindowMass_nonneg {lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (u v : ℝ) : 0 ≤ primeNormalizedLogOddsWindowMass lam u v := by apply sum_nonneg intro p hp have h := (primeLogOddsIntensity_normalized_correction hlam hlam2 (mem_primeLogWindow.mp hp).1).1 linarith [show 0 ≤ 1 / (p : ℝ) by positivity] theorem primeNormalizedLogOddsWindowMass_mono {lam u v z : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hvz : v ≤ z) : primeNormalizedLogOddsWindowMass lam u v ≤ primeNormalizedLogOddsWindowMass lam u z := by apply sum_le_sum_of_subset_of_nonneg · intro p hp obtain ⟨hp, hlu, hlv⟩ := mem_primeLogWindow.mp hp exact mem_primeLogWindow.mpr ⟨hp, hlu, hlv.trans hvz⟩ · intro p hp _ have h := (primeLogOddsIntensity_normalized_correction hlam hlam2 (mem_primeLogWindow.mp hp).1).1 linarith [show 0 ≤ 1 / (p : ℝ) by positivity] theorem primeNormalizedLogOddsWindowMass_broad_bounds {lam u w : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) : w / (4 * u) ≤ primeNormalizedLogOddsWindowMass lam u (u + w) ∧ primeNormalizedLogOddsWindowMass lam u (u + w) ≤ 5 * w / (4 * u) := by have hu0 : 0 < u := hw.trans_le hwu obtain ⟨_, hloglo, hloghi⟩ := logUniform_log_bounds hw hwu have hloglo' : w / (2 * u) ≤ log (1 + w / u) := (div_le_div_of_nonneg_left hw.le (add_pos hu0 hw) (by linarith : u + w ≤ 2 * u)).trans hloglo have herr : 2 * primeLogOddsErrorConstant / u ≤ w / (4 * u) := by calc _ ≤ (w / 4) / u := div_le_div_of_nonneg_right (by linarith) hu0.le _ = _ := by ring have he := primeNormalizedLogOddsWindowMass_estimate hlam hlam2 hu (by linarith : u ≤ u + w) have hid : (u + w) / u = 1 + w / u := by field_simp rw [hid] at he have helo := (abs_le.mp he).1 have hehi := (abs_le.mp he).2 constructor · have hid' : w / (2 * u) - w / (4 * u) = w / (4 * u) := by ring linarith · have hid' : w / u + w / (4 * u) = 5 * w / (4 * u) := by ring linarith /-- A normalization identity keeps the CDF error to twice the unnormalized error divided by the continuous total mass. -/ theorem normalized_cdf_error_le {a b s h delta : ℝ} (ha0 : 0 ≤ a) (has : a ≤ s) (hs : 0 < s) (hh : 0 < h) (hab : |a - b| ≤ delta) (hsh : |s - h| ≤ delta) : |a / s - b / h| ≤ 2 * delta / h := by have hd : 0 ≤ delta := (abs_nonneg _).trans hab have hq0 : 0 ≤ a / s := div_nonneg ha0 hs.le have hq1 : a / s ≤ 1 := (div_le_one hs).mpr has have hid : a / s - b / h = ((a - b) - (a / s) * (s - h)) / h := by field_simp ring rw [hid, abs_div, abs_of_pos hh] apply div_le_div_of_nonneg_right _ hh.le calc _ ≤ |a - b| + |(a / s) * (s - h)| := abs_sub _ _ _ = |a - b| + (a / s) * |s - h| := by rw [abs_mul, abs_of_nonneg hq0] _ ≤ delta + (a / s) * delta := add_le_add hab (mul_le_mul_of_nonneg_left hsh hq0) _ ≤ 2 * delta := by nlinarith theorem primeNormalizedLogOddsWindowMass_cdf_estimate {lam u w v : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) (huv : u ≤ v) (hvw : v ≤ u + w) : |primeNormalizedLogOddsWindowMass lam u v / primeNormalizedLogOddsWindowMass lam u (u + w) - log (v / u) / log (1 + w / u)| ≤ 8 * primeLogOddsErrorConstant / w := by have hC := primeLogOddsErrorConstant_pos have hu0 : 0 < u := hw.trans_le hwu obtain ⟨hh, hloglo, _⟩ := logUniform_log_bounds hw hwu have hloglo' : w / (2 * u) ≤ log (1 + w / u) := (div_le_div_of_nonneg_left hw.le (add_pos hu0 hw) (by linarith : u + w ≤ 2 * u)).trans hloglo have hmass := (primeNormalizedLogOddsWindowMass_broad_bounds hlam hlam2 hu hw hwu hlarge).1 have hmass0 : 0 < primeNormalizedLogOddsWindowMass lam u (u + w) := (by positivity : 0 < w / (4 * u)).trans_le hmass have he := primeNormalizedLogOddsWindowMass_estimate hlam hlam2 hu (by linarith : u ≤ u + w) have hid : (u + w) / u = 1 + w / u := by field_simp rw [hid] at he have h := normalized_cdf_error_le (primeNormalizedLogOddsWindowMass_nonneg hlam hlam2 u v) (primeNormalizedLogOddsWindowMass_mono hlam hlam2 hvw) hmass0 hh (primeNormalizedLogOddsWindowMass_estimate hlam hlam2 hu huv) he calc _ ≤ 2 * (2 * primeLogOddsErrorConstant / u) / log (1 + w / u) := h _ ≤ 2 * (2 * primeLogOddsErrorConstant / u) / (w / (2 * u)) := div_le_div_of_nonneg_left (by positivity) (by positivity) hloglo' _ = _ := by field_simp; ring theorem primeNormalizedLogOddsWindowMass_ratio_eq_markSum {lam u w v : ℝ} (hlam : 0 < lam) : primeNormalizedLogOddsWindowMass lam u v / primeNormalizedLogOddsWindowMass lam u (u + w) = ∑ p ∈ primeLogWindow u v, primeLogOddsMarkWeight lam u (u + w) p := by unfold primeNormalizedLogOddsWindowMass primeLogOddsMarkWeight simp only [← sum_div] exact div_div_div_cancel_right₀ hlam.ne' _ _ theorem primeLogWindow_filter_log_le {u v z : ℝ} (hvz : v ≤ z) : (primeLogWindow u z).filter (fun p : ℕ ↦ log (p : ℝ) ≤ v) = primeLogWindow u v := by ext p simp only [Finset.mem_filter, mem_primeLogWindow] constructor · exact fun ⟨⟨hp, hu, _⟩, hv⟩ ↦ ⟨hp, hu, hv⟩ · exact fun ⟨hp, hu, hv⟩ ↦ ⟨⟨hp, hu, hv.trans hvz⟩, hv⟩ theorem primeLogOddsMark_cdf_estimate {lam u w v : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) (huv : u ≤ v) (hvw : v ≤ u + w) : |(∑ p ∈ (primeLogWindow u (u + w)).filter (fun p : ℕ ↦ log (p : ℝ) ≤ v), primeLogOddsMarkWeight lam u (u + w) p) - log (v / u) / log (1 + w / u)| ≤ 8 * primeLogOddsErrorConstant / w := by rw [primeLogWindow_filter_log_le hvw, ← primeNormalizedLogOddsWindowMass_ratio_eq_markSum (by linarith : 0 < lam)] exact primeNormalizedLogOddsWindowMass_cdf_estimate hlam hlam2 hu hw hwu hlarge huv hvw theorem sum_Ioc_reciprocal_kernel_le {N M : ℕ} (hN : 1 ≤ N) : (∑ p ∈ Ioc N M, 1 / ((p : ℝ) * ((p : ℝ) - 1))) ≤ 1 / (N : ℝ) := by have hi : Ioc N M = Ico (N + 1) (M + 1) := by ext p simp only [Finset.mem_Ioc, Finset.mem_Ico] omega rw [hi, sum_Ico_eq_sum_range] have h := sum_reciprocal_correction_tail_le (f := fun p ↦ 1 / ((p : ℝ) * ((p : ℝ) - 1))) (fun _ _ ↦ le_rfl) hN ((M + 1) - (N + 1)) have h' := h.trans (sub_le_self _ (by positivity)) simpa only [Nat.add_comm] using h' theorem reciprocal_floor_exp_le_two_div {u : ℝ} (hu : log 2 ≤ u) : 1 ≤ ⌊exp u⌋₊ ∧ 1 / (⌊exp u⌋₊ : ℝ) ≤ 2 / u := by have hu0 : 0 < u := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hu have heu : 2 ≤ exp u := (log_le_iff_le_exp (by norm_num : (0 : ℝ) < 2)).mp hu have hf := Nat.div_two_lt_floor (by linarith : 1 ≤ exp u) have hN0 : (0 : ℝ) < ⌊exp u⌋₊ := by linarith [exp_pos u] constructor · have : 0 < ⌊exp u⌋₊ := by exact_mod_cast hN0 omega · apply (div_le_div_iff₀ hN0 hu0).mpr linarith [add_one_le_exp u] noncomputable def primeReciprocalOddsWindowMass (u v : ℝ) : ℝ := ∑ p ∈ primeLogWindow u v, 1 / ((p : ℝ) - 1) theorem primeReciprocalOddsWindowMass_correction {u v : ℝ} (hu : log 2 ≤ u) : 0 ≤ primeReciprocalOddsWindowMass u v - primeLogWindowMass u v ∧ primeReciprocalOddsWindowMass u v - primeLogWindowMass u v ≤ 2 / u := by have hf := reciprocal_floor_exp_le_two_div hu have hid : primeReciprocalOddsWindowMass u v - primeLogWindowMass u v = ∑ p ∈ primeLogWindow u v, 1 / ((p : ℝ) * ((p : ℝ) - 1)) := by unfold primeReciprocalOddsWindowMass primeLogWindowMass primeLogWindow rw [← sum_sub_distrib] apply sum_congr rfl intro p hp have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast (mem_primeLogWindow.mp hp).1.two_le field_simp [(by linarith : (p : ℝ) - 1 ≠ 0), (by linarith : (p : ℝ) ≠ 0)] ring rw [hid] constructor · apply sum_nonneg intro p hp have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast (mem_primeLogWindow.mp hp).1.two_le exact one_div_nonneg.mpr (mul_nonneg (Nat.cast_nonneg p) (by linarith)) · apply le_trans _ ((sum_Ioc_reciprocal_kernel_le (M := ⌊exp v⌋₊) hf.1).trans hf.2) apply sum_le_sum_of_subset_of_nonneg · exact filter_subset _ _ · intro p hp _ have hp2 : (2 : ℝ) ≤ p := by have : 2 ≤ p := by have := (Finset.mem_Ioc.mp hp).1; omega exact_mod_cast this exact one_div_nonneg.mpr (mul_nonneg (Nat.cast_nonneg p) (by linarith)) theorem primeReciprocalOddsWindowMass_estimate {u v : ℝ} (hu : log 2 ≤ u) (huv : u ≤ v) : |primeReciprocalOddsWindowMass u v - log (v / u)| ≤ 2 * primeLogOddsErrorConstant / u := by have hu0 : 0 < u := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hu have hc := primeReciprocalOddsWindowMass_correction (v := v) hu have hr := primeLogWindowMass_estimate hu huv have hid : primeReciprocalOddsWindowMass u v - log (v / u) = (primeReciprocalOddsWindowMass u v - primeLogWindowMass u v) + (primeLogWindowMass u v - log (v / u)) := by ring rw [hid] calc _ ≤ |primeReciprocalOddsWindowMass u v - primeLogWindowMass u v| + |primeLogWindowMass u v - log (v / u)| := abs_add_le _ _ _ ≤ 2 / u + 2 * mertensErrorConstant / u := by rw [abs_of_nonneg hc.1] exact add_le_add hc.2 hr _ ≤ _ := by unfold primeLogOddsErrorConstant have : 0 ≤ u⁻¹ := inv_nonneg.mpr hu0.le ring_nf linarith theorem primeReciprocalOddsWindowMass_nonneg (u v : ℝ) : 0 ≤ primeReciprocalOddsWindowMass u v := by apply sum_nonneg intro p hp have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast (mem_primeLogWindow.mp hp).1.two_le exact one_div_nonneg.mpr (by linarith) theorem primeReciprocalOddsWindowMass_mono {u v z : ℝ} (hvz : v ≤ z) : primeReciprocalOddsWindowMass u v ≤ primeReciprocalOddsWindowMass u z := by apply sum_le_sum_of_subset_of_nonneg · intro p hp obtain ⟨hp, hlu, hlv⟩ := mem_primeLogWindow.mp hp exact mem_primeLogWindow.mpr ⟨hp, hlu, hlv.trans hvz⟩ · intro p hp _ have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast (mem_primeLogWindow.mp hp).1.two_le exact one_div_nonneg.mpr (by linarith) theorem primeReciprocalOddsWindowMass_broad_bounds {u w : ℝ} (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) : w / (4 * u) ≤ primeReciprocalOddsWindowMass u (u + w) ∧ primeReciprocalOddsWindowMass u (u + w) ≤ 5 * w / (4 * u) := by have hu0 : 0 < u := hw.trans_le hwu obtain ⟨_, hloglo, hloghi⟩ := logUniform_log_bounds hw hwu have hloglo' : w / (2 * u) ≤ log (1 + w / u) := (div_le_div_of_nonneg_left hw.le (add_pos hu0 hw) (by linarith : u + w ≤ 2 * u)).trans hloglo have herr : 2 * primeLogOddsErrorConstant / u ≤ w / (4 * u) := by calc _ ≤ (w / 4) / u := div_le_div_of_nonneg_right (by linarith) hu0.le _ = _ := by ring have he := primeReciprocalOddsWindowMass_estimate hu (by linarith : u ≤ u + w) have hid : (u + w) / u = 1 + w / u := by field_simp rw [hid] at he have helo := (abs_le.mp he).1 have hehi := (abs_le.mp he).2 constructor · have hid' : w / (2 * u) - w / (4 * u) = w / (4 * u) := by ring linarith · have hid' : w / u + w / (4 * u) = 5 * w / (4 * u) := by ring linarith theorem primeReciprocalOddsWindowMass_cdf_estimate {u w v : ℝ} (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) (huv : u ≤ v) (hvw : v ≤ u + w) : |primeReciprocalOddsWindowMass u v / primeReciprocalOddsWindowMass u (u + w) - log (v / u) / log (1 + w / u)| ≤ 8 * primeLogOddsErrorConstant / w := by have hC := primeLogOddsErrorConstant_pos have hu0 : 0 < u := hw.trans_le hwu obtain ⟨hh, hloglo, _⟩ := logUniform_log_bounds hw hwu have hloglo' : w / (2 * u) ≤ log (1 + w / u) := (div_le_div_of_nonneg_left hw.le (add_pos hu0 hw) (by linarith : u + w ≤ 2 * u)).trans hloglo have hmass := (primeReciprocalOddsWindowMass_broad_bounds hu hw hwu hlarge).1 have hmass0 : 0 < primeReciprocalOddsWindowMass u (u + w) := (by positivity : 0 < w / (4 * u)).trans_le hmass have he := primeReciprocalOddsWindowMass_estimate hu (by linarith : u ≤ u + w) have hid : (u + w) / u = 1 + w / u := by field_simp rw [hid] at he have h := normalized_cdf_error_le (primeReciprocalOddsWindowMass_nonneg u v) (primeReciprocalOddsWindowMass_mono hvw) hmass0 hh (primeReciprocalOddsWindowMass_estimate hu huv) he calc _ ≤ 2 * (2 * primeLogOddsErrorConstant / u) / log (1 + w / u) := h _ ≤ 2 * (2 * primeLogOddsErrorConstant / u) / (w / (2 * u)) := div_le_div_of_nonneg_left (by positivity) (by positivity) hloglo' _ = _ := by field_simp; ring noncomputable def primeReciprocalOddsMarkWeight (u v : ℝ) (p : ℕ) : ℝ := (1 / ((p : ℝ) - 1)) / primeReciprocalOddsWindowMass u v theorem primeReciprocalOddsMarkWeight_normalized {u w : ℝ} (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) : (∀ p ∈ primeLogWindow u (u + w), 0 < primeReciprocalOddsMarkWeight u (u + w) p) ∧ (∑ p ∈ primeLogWindow u (u + w), primeReciprocalOddsMarkWeight u (u + w) p) = 1 := by have hu0 : 0 < u := hw.trans_le hwu have hmass := (primeReciprocalOddsWindowMass_broad_bounds hu hw hwu hlarge).1 have hm0 : 0 < primeReciprocalOddsWindowMass u (u + w) := (by positivity : 0 < w / (4 * u)).trans_le hmass constructor · intro p hp have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast (mem_primeLogWindow.mp hp).1.two_le exact div_pos (one_div_pos.mpr (by linarith)) hm0 · simp only [primeReciprocalOddsMarkWeight, ← sum_div] exact div_self hm0.ne' theorem primeReciprocalOddsMark_cdf_estimate {u w v : ℝ} (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) (huv : u ≤ v) (hvw : v ≤ u + w) : |(∑ p ∈ (primeLogWindow u (u + w)).filter (fun p : ℕ ↦ log (p : ℝ) ≤ v), primeReciprocalOddsMarkWeight u (u + w) p) - log (v / u) / log (1 + w / u)| ≤ 8 * primeLogOddsErrorConstant / w := by rw [primeLogWindow_filter_log_le hvw] simp only [primeReciprocalOddsMarkWeight, ← sum_div] exact primeReciprocalOddsWindowMass_cdf_estimate hu hw hwu hlarge huv hvw theorem exists_uniform_primeLogOdds_mertens : ∃ C > 0, ∀ lam : ℝ, 1 ≤ lam → lam ≤ 2 → ∃ c : ℝ, ∀ v : ℝ, log 2 ≤ v → |primeNormalizedLogOddsSum lam (exp v) - log v - c| ≤ C / v := by refine ⟨primeLogOddsErrorConstant, primeLogOddsErrorConstant_pos, ?_⟩ intro lam hlam hlam2 exact ⟨primeLogOddsMertensConstant lam, fun _ hv ↦ primeNormalizedLogOddsSum_estimate hlam hlam2 hv⟩ end Erdos859Verification end /- Inlined development module: PrimeIntensityCountLower.lean -/ section /- Lower bounds for the actual tilted subset law from independent finite marks. The log-odds intensities are subweights of the reciprocal odds. Distinct ordered marks therefore give an exact factorial-counting lower bound, without asserting that conditioning a Bernoulli subset on its cardinality makes its points iid. -/ namespace Erdos859Verification open Finset Real theorem normalized_injective_tuple_sum {α : Type*} [DecidableEq α] (P : Finset α) (n : ℕ) (w : α → ℝ) (F : Finset α → ℝ) {M : ℝ} (hM : M ≠ 0) : M ^ n / (n.factorial : ℝ) * (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, w (x i).val / M) * F (tupleSupport x)) = ∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), (∏ p ∈ T, w p) * F T := by have ht (x : Fin n → P) : (∏ i, w (x i).val / M) = (∏ i, w (x i).val) / M ^ n := by rw [prod_div_distrib] simp simp_rw [ht, div_mul_eq_mul_div] rw [← sum_div, sum_injective_tuple_product] have hf : (n.factorial : ℝ) ≠ 0 := by exact_mod_cast Nat.factorial_ne_zero n field_simp theorem primeTiltWeight_empty_eq_exp_neg_intensity {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) : primeTiltWeight P lam ∅ = exp (-(∑ p ∈ P, primeLogOddsIntensity lam p)) := by have hp0 (p : ℕ) (hp : p ∈ P) : (p : ℝ) ≠ 0 := by exact_mod_cast (hP p hp).ne_zero have hd (p : ℕ) (hp : p ∈ P) : 0 < (p : ℝ) - 1 := by have h : (1 : ℝ) < p := by exact_mod_cast (hP p hp).one_lt linarith have hx (p : ℕ) (hp : p ∈ P) : 0 < 1 + lam / ((p : ℝ) - 1) := by exact add_pos_of_pos_of_nonneg zero_lt_one (div_nonneg hlam.le (hd p hp).le) unfold primeTiltWeight primePatternWeight primeTiltNormalizer simp only [Finset.notMem_empty, if_false, card_empty, pow_zero, mul_one] rw [← prod_div_distrib, exp_neg, exp_sum, ← prod_inv_distrib] apply prod_congr rfl intro p hp rw [primeLogOddsIntensity, exp_log (hx p hp)] have hd' := (hd p hp).ne' have hn : 1 + (lam - 1) / (p : ℝ) ≠ 0 := by have heq : 1 + (lam - 1) / (p : ℝ) = ((p : ℝ) - 1 + lam) / p := by field_simp [hp0 p hp]; ring rw [heq] exact (div_pos (by linarith [hd p hp]) (by exact_mod_cast (hP p hp).pos)).ne' rw [← one_div] apply (div_eq_div_iff hn (hx p hp).ne').mpr field_simp [hp0 p hp, hd'] ring theorem primeTiltWeight_eq_empty_mul_tilted_odds {P T : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hT : T ⊆ P) (lam : ℝ) : primeTiltWeight P lam T = primeTiltWeight P lam ∅ * ∏ p ∈ T, lam / ((p : ℝ) - 1) := by rw [primeTiltWeight_fixedCard_factorization hP hT rfl] simp only [primeTiltWeight, card_empty, pow_zero, mul_one, primeOddsWeight, prod_div_distrib, prod_const, one_pow] ring theorem primeTilt_count_lower_from_subweights {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (n : ℕ) (w : ℕ → ℝ) (F : Finset ℕ → ℝ) (hw : ∀ p ∈ P, 0 ≤ w p) (hodds : ∀ p ∈ P, w p ≤ lam / ((p : ℝ) - 1)) (hF : ∀ T ∈ P.powerset.filter (fun T ↦ T.card = n), 0 ≤ F T) (hM : 0 < ∑ p ∈ P, w p) : exp (-(∑ p ∈ P, primeLogOddsIntensity lam p)) * (∑ p ∈ P, w p) ^ n / (n.factorial : ℝ) * (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, w (x i).val / (∑ p ∈ P, w p)) * F (tupleSupport x)) ≤ ∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T * F T := by have heq := normalized_injective_tuple_sum P n w F hM.ne' calc _ = exp (-(∑ p ∈ P, primeLogOddsIntensity lam p)) * ((∑ p ∈ P, w p) ^ n / (n.factorial : ℝ) * (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, w (x i).val / (∑ p ∈ P, w p)) * F (tupleSupport x))) := by ring _ = exp (-(∑ p ∈ P, primeLogOddsIntensity lam p)) * (∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), (∏ p ∈ T, w p) * F T) := by rw [heq] _ ≤ _ := by rw [mul_sum] apply sum_le_sum intro T hT have hTP := mem_powerset.mp (mem_filter.mp hT).1 rw [primeTiltWeight_eq_empty_mul_tilted_odds hP hTP, primeTiltWeight_empty_eq_exp_neg_intensity hP hlam] rw [← mul_assoc] apply mul_le_mul_of_nonneg_right _ (hF T hT) apply mul_le_mul_of_nonneg_left _ (exp_pos _).le exact prod_le_prod (fun p hp ↦ hw p (hTP hp)) (fun p hp ↦ hodds p (hTP hp)) theorem primeLogOddsIntensity_le_odds {lam : ℝ} {p : ℕ} (hlam : 0 < lam) (hp : p.Prime) : 0 ≤ primeLogOddsIntensity lam p ∧ primeLogOddsIntensity lam p ≤ lam / ((p : ℝ) - 1) := by have hd : 0 < (p : ℝ) - 1 := by have h : (1 : ℝ) < p := by exact_mod_cast hp.one_lt linarith have hx : 0 < lam / ((p : ℝ) - 1) := div_pos hlam hd constructor · exact log_nonneg (by linarith) · have h := log_le_sub_one_of_pos (by linarith : 0 < 1 + lam / ((p : ℝ) - 1)) simpa only [primeLogOddsIntensity, add_sub_cancel_left] using h theorem primeTilt_count_lower_from_intensity_marks {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (n : ℕ) (F : Finset ℕ → ℝ) (hF : ∀ T ∈ P.powerset.filter (fun T ↦ T.card = n), 0 ≤ F T) (hM : 0 < ∑ p ∈ P, primeLogOddsIntensity lam p) : exp (-(∑ p ∈ P, primeLogOddsIntensity lam p)) * (∑ p ∈ P, primeLogOddsIntensity lam p) ^ n / (n.factorial : ℝ) * (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, primeLogOddsIntensity lam (x i).val / (∑ p ∈ P, primeLogOddsIntensity lam p)) * F (tupleSupport x)) ≤ ∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T * F T := primeTilt_count_lower_from_subweights hP hlam n (primeLogOddsIntensity lam) F (fun p hp ↦ (primeLogOddsIntensity_le_odds hlam (hP p hp)).1) (fun p hp ↦ (primeLogOddsIntensity_le_odds hlam (hP p hp)).2) hF hM end Erdos859Verification end /- Inlined development module: FiniteInjectiveGood.lean -/ section /- Removing duplicate tuples from a good event under a finite iid law. -/ namespace Erdos859Verification open Finset theorem finite_good_intersection_lower {α : Type*} [Fintype α] (w : α → ℝ) (Good Keep : α → Prop) [DecidablePred Good] [DecidablePred Keep] (hw : ∀ x, 0 ≤ w x) (hnorm : ∑ x, w x = 1) {b c : ℝ} (hbad : (∑ x, w x * (if Good x then 0 else 1)) ≤ b) (hdiscard : (∑ x, w x * (if Keep x then 0 else 1)) ≤ c) : 1 - b - c ≤ ∑ x ∈ univ.filter (fun x ↦ Keep x ∧ Good x), w x := by classical have hp (x : α) : w x ≤ (if Keep x ∧ Good x then w x else 0) + w x * (if Good x then 0 else 1) + w x * (if Keep x then 0 else 1) := by by_cases hg : Good x <;> by_cases hk : Keep x <;> simp [hg, hk, hw x] have hs := sum_le_sum (fun x (_ : x ∈ (univ : Finset α)) ↦ hp x) rw [sum_add_distrib, sum_add_distrib, hnorm, ← sum_filter] at hs linarith theorem finite_iid_injective_good_probability_lower {α : Type*} [Fintype α] [DecidableEq α] (n : ℕ) (w : α → ℝ) (Good : (Fin n → α) → Prop) [DecidablePred Good] {a b : ℝ} (ha : 0 ≤ a) (hw : ∀ y, 0 ≤ w y) (hnorm : ∑ y, w y = 1) (hatom : ∀ y, w y ≤ a) (hbad : (∑ x : Fin n → α, finiteProductWeight (fun _ ↦ w) x * (if Good x then 0 else 1)) ≤ b) : 1 - b - (n : ℝ) ^ 2 * a ≤ ∑ x ∈ univ.filter (fun x : Fin n → α ↦ Function.Injective x ∧ Good x), finiteProductWeight (fun _ ↦ w) x := by classical apply finite_good_intersection_lower (finiteProductWeight (fun _ ↦ w)) Good Function.Injective (finiteProductWeight_nonneg (fun _ ↦ hw)) (sum_finiteProductWeight _ (fun _ ↦ hnorm)) hbad have he (x : Fin n → α) : (if Function.Injective x then (0 : ℝ) else 1) = (if ∃ i j : Fin n, i ≠ j ∧ x i = x j then 1 else 0) := by by_cases hx : Function.Injective x · have hnot : ¬ ∃ i j : Fin n, i ≠ j ∧ x i = x j := by rintro ⟨i, j, hij, heq⟩ exact hij (hx heq) simp [hx, hnot] · obtain ⟨i, j, heq, hij⟩ := Function.not_injective_iff.mp hx simp [hx, show ∃ i j : Fin n, i ≠ j ∧ x i = x j from ⟨i, j, hij, heq⟩] simp_rw [he] exact finite_iid_duplicate_probability_le n w ha hw hnorm hatom end Erdos859Verification end /- Inlined development module: PrimeGoodCount.lean -/ section /- An independent-mark success estimate gives an actual tilted subset event. -/ namespace Erdos859Verification open Finset Real noncomputable def primeIntensityTupleWeight {P : Finset ℕ} {n : ℕ} (lam : ℝ) (x : Fin n → P) : ℝ := finiteProductWeight (fun _ p ↦ primeLogOddsIntensity lam p.val / ∑ q ∈ P, primeLogOddsIntensity lam q) x theorem primeIntensityTupleWeight_normalized {P : Finset ℕ} {lam : ℝ} (hM : 0 < ∑ p ∈ P, primeLogOddsIntensity lam p) (n : ℕ) : (∑ x : Fin n → P, primeIntensityTupleWeight lam x) = 1 := by apply sum_finiteProductWeight intro i rw [← sum_div] simp only [Finset.sum_coe_sort] exact div_self hM.ne' theorem primeTilt_good_count_lower {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (n : ℕ) (Good : Finset ℕ → Prop) [DecidablePred Good] (hM : 0 < ∑ p ∈ P, primeLogOddsIntensity lam p) {alpha beta : ℝ} (halpha : 0 ≤ alpha) (hatom : ∀ p ∈ P, primeLogOddsIntensity lam p / (∑ q ∈ P, primeLogOddsIntensity lam q) ≤ alpha) (hbad : (∑ x : Fin n → P, primeIntensityTupleWeight lam x * (if Good (tupleSupport x) then 0 else 1)) ≤ beta) : exp (-(∑ p ∈ P, primeLogOddsIntensity lam p)) * (∑ p ∈ P, primeLogOddsIntensity lam p) ^ n / (n.factorial : ℝ) * (1 - beta - (n : ℝ) ^ 2 * alpha) ≤ ∑ T ∈ P.powerset.filter (fun T ↦ T.card = n ∧ Good T), primeTiltWeight P lam T := by classical let w : P → ℝ := fun p ↦ primeLogOddsIntensity lam p.val / ∑ q ∈ P, primeLogOddsIntensity lam q have hw (p : P) : 0 ≤ w p := div_nonneg (primeLogOddsIntensity_le_odds hlam (hP p.val p.property)).1 hM.le have hnorm : ∑ p, w p = 1 := by simp only [w, ← sum_div, Finset.sum_coe_sort] exact div_self hM.ne' have hg := finite_iid_injective_good_probability_lower n w (fun x ↦ Good (tupleSupport x)) halpha hw hnorm (fun p ↦ hatom p.val p.property) hbad have hc := primeTilt_count_lower_from_intensity_marks hP hlam n (fun T ↦ if Good T then 1 else 0) (fun T _ ↦ by split_ifs <;> norm_num) hM have ht : (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, primeLogOddsIntensity lam (x i).val / (∑ p ∈ P, primeLogOddsIntensity lam p)) * (if Good (tupleSupport x) then 1 else 0)) = ∑ x ∈ univ.filter (fun x : Fin n → P ↦ Function.Injective x ∧ Good (tupleSupport x)), finiteProductWeight (fun _ ↦ w) x := by simp only [sum_filter, w, finiteProductWeight, mul_ite, mul_one, mul_zero, ite_and] rw [ht] at hc have hcoeff : 0 ≤ exp (-(∑ p ∈ P, primeLogOddsIntensity lam p)) * (∑ p ∈ P, primeLogOddsIntensity lam p) ^ n / (n.factorial : ℝ) := by positivity have h := (mul_le_mul_of_nonneg_left hg hcoeff).trans hc simpa only [sum_filter, mul_ite, mul_one, mul_zero, ite_and] using h theorem primeLogOddsIntensity_broad_mass_le {lam v eps : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) (heps : 0 < eps) (hlarge : 8 * mertensErrorConstant ≤ eps * v) : (∑ p ∈ primeLogWindow v ((1 + eps) * v), primeLogOddsIntensity lam p) ≤ 5 * eps := by calc _ ≤ ∑ p ∈ primeLogWindow v ((1 + eps) * v), 4 * (1 / (p : ℝ)) := by apply sum_le_sum intro p hp simpa only [mul_one_div] using (primeLogOddsIntensity_bounds hlam hlam2 (mem_primeLogWindow.mp hp).1).2 _ = 4 * primeLogWindowMass v ((1 + eps) * v) := by rw [← mul_sum]; rfl _ ≤ _ := by have h := primeLogWindowMass_broad_upper hv heps hlarge linarith theorem primeTilt_broad_good_count_lower {lam v eps : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) (n : ℕ) (Good : Finset ℕ → Prop) [DecidablePred Good] {beta eta : ℝ} (heta : 0 ≤ eta) (hmargin : eta ≤ 1 - beta - (n : ℝ) ^ 2 * (16 * exp (-v) / eps)) (hbad : (∑ x : Fin n → primeLogWindow v ((1 + eps) * v), primeIntensityTupleWeight lam x * (if Good (tupleSupport x) then 0 else 1)) ≤ beta) : eta * exp (-5 * eps) * (eps / 4) ^ n / (n.factorial : ℝ) ≤ ∑ T ∈ (primeLogWindow v ((1 + eps) * v)).powerset.filter (fun T ↦ T.card = n ∧ Good T), primeTiltWeight (primeLogWindow v ((1 + eps) * v)) lam T := by let P := primeLogWindow v ((1 + eps) * v) let mu := ∑ p ∈ P, primeLogOddsIntensity lam p have hlo : eps / 4 ≤ mu := primeLogOddsIntensity_broad_mass_lower hlam hlam2 hv heps heps1 hlarge have hhi : mu ≤ 5 * eps := primeLogOddsIntensity_broad_mass_le hlam hlam2 hv heps hlarge have hm : 0 < mu := (by positivity : 0 < eps / 4).trans_le hlo have hcoeff : exp (-5 * eps) * (eps / 4) ^ n / (n.factorial : ℝ) ≤ exp (-mu) * mu ^ n / (n.factorial : ℝ) := by apply div_le_div_of_nonneg_right _ (by positivity) exact mul_le_mul (exp_le_exp.mpr (by linarith)) (pow_le_pow_left₀ (by positivity) hlo n) (by positivity) (exp_pos _).le have h := primeTilt_good_count_lower (P := P) (fun p hp ↦ (mem_primeLogWindow.mp hp).1) (lt_of_lt_of_le zero_lt_one hlam) n Good hm (alpha := 16 * exp (-v) / eps) (by positivity) (fun p hp ↦ primeLogOddsMark_broad_atom_upper hlam hlam2 hv heps heps1 hlarge hp) hbad calc _ = (exp (-5 * eps) * (eps / 4) ^ n / (n.factorial : ℝ)) * eta := by ring _ ≤ (exp (-mu) * mu ^ n / (n.factorial : ℝ)) * eta := mul_le_mul_of_nonneg_right hcoeff heta _ ≤ (exp (-mu) * mu ^ n / (n.factorial : ℝ)) * (1 - beta - (n : ℝ) ^ 2 * (16 * exp (-v) / eps)) := mul_le_mul_of_nonneg_left hmargin (by positivity) _ ≤ _ := h end Erdos859Verification end /- Inlined development module: FiniteCountCost.lean -/ section /- Elementary lower bounds for the cost of prescribing a finite mark count. -/ namespace Erdos859Verification open Real theorem broad_count_cost_lower {eps : ℝ} (heps : 0 < eps) {n : ℕ} (hn : 0 < n) : exp (-5 * eps - (n : ℝ) * log (4 * n / eps)) ≤ exp (-5 * eps) * (eps / 4) ^ n / (n.factorial : ℝ) := by have hnR : (0 : ℝ) < n := by exact_mod_cast hn have hf : (0 : ℝ) < n.factorial := by exact_mod_cast Nat.factorial_pos n have hep : 0 < eps / 4 := by positivity have hfac : log (n.factorial : ℝ) ≤ (n : ℝ) * log n := by have hpow : (n.factorial : ℝ) ≤ (n : ℝ) ^ n := by exact_mod_cast Nat.factorial_le_pow n simpa only [log_pow] using log_le_log hf hpow have hid : 4 * (n : ℝ) / eps = n / (eps / 4) := by ring apply (log_le_log_iff (exp_pos _) (by positivity)).mp rw [log_exp, log_div (by positivity) hf.ne', log_mul (exp_pos _).ne' (pow_pos hep n).ne', log_exp, log_pow, hid, log_div hnR.ne' hep.ne'] nlinarith end Erdos859Verification end /- Inlined development module: FiniteCountAsymptotics.lean -/ section /- Sublinear prescribed counts have zero exponential cost in polynomially wide prime-log windows. -/ namespace Erdos859Verification open Real Filter open scoped Topology theorem tendsto_rpow_affine_log_div_nat {r : ℝ} (hr : r < 1) (a b : ℝ) : Tendsto (fun k : ℕ ↦ (k : ℝ) ^ r * (a + b * log k) / k) atTop (𝓝 0) := by have hpos : 0 < 1 - r := by linarith have hp : Tendsto (fun k : ℕ ↦ (k : ℝ) ^ r / k) atTop (𝓝 0) := by have h := (tendsto_rpow_neg_atTop hpos).comp (tendsto_natCast_atTop_atTop (R := ℝ)) apply h.congr' filter_upwards [eventually_gt_atTop 0] with k hk have hkR : (0 : ℝ) < k := by exact_mod_cast hk simp only [Function.comp_def] rw [neg_sub, rpow_sub hkR, rpow_one] have hl : Tendsto (fun k : ℕ ↦ (k : ℝ) ^ r * log k / k) atTop (𝓝 0) := by have h := (isLittleO_log_rpow_atTop hpos).tendsto_div_nhds_zero.comp (tendsto_natCast_atTop_atTop (R := ℝ)) apply h.congr' filter_upwards [eventually_gt_atTop 0] with k hk have hkR : (0 : ℝ) < k := by exact_mod_cast hk simp only [Function.comp_def] rw [rpow_sub hkR, rpow_one] field_simp convert (hp.const_mul a).add (hl.const_mul b) using 1 · ext k ring · ring theorem broad_count_cost_polynomial_bound {k n : ℕ} {eps C D r : ℝ} (hk : 0 < k) (hn : 0 < n) (hC : 0 < C) (heps : 0 < eps) (heps1 : eps ≤ 1) (hepslow : (k : ℝ) ^ (-D) ≤ eps) (hnupper : (n : ℝ) ≤ C * (k : ℝ) ^ r) : 0 ≤ 5 * eps + (n : ℝ) * log (4 * n / eps) ∧ 5 * eps + (n : ℝ) * log (4 * n / eps) ≤ 5 + C * (k : ℝ) ^ r * (log (4 * C) + (r + D) * log k) := by have hkR : (0 : ℝ) < k := by exact_mod_cast hk have hnR : (1 : ℝ) ≤ n := by exact_mod_cast hn have hp : 0 < (k : ℝ) ^ (-D) := rpow_pos_of_pos hkR _ have hlogpos : 0 ≤ log (4 * n / eps) := by apply log_nonneg apply (le_div_iff₀ heps).mpr nlinarith have hratio : 4 * (n : ℝ) / eps ≤ 4 * C * (k : ℝ) ^ (r + D) := by calc _ ≤ (4 * C * (k : ℝ) ^ r) / (k : ℝ) ^ (-D) := div_le_div₀ (by positivity) (by nlinarith) hp hepslow _ = _ := by rw [rpow_add hkR, rpow_neg hkR.le]; simp only [div_eq_mul_inv, inv_inv]; ring have hlog : log (4 * n / eps) ≤ log (4 * C) + (r + D) * log k := by have h := log_le_log (by positivity : 0 < 4 * (n : ℝ) / eps) hratio rwa [log_mul (by positivity) (rpow_pos_of_pos hkR _).ne', log_rpow hkR] at h constructor · positivity · have hm := mul_le_mul hnupper hlog hlogpos (by positivity : 0 ≤ C * (k : ℝ) ^ r) nlinarith theorem tendsto_broad_count_cost_div {n : ℕ → ℕ} {eps : ℕ → ℝ} {C D r : ℝ} (hC : 0 < C) (hr : r < 1) (hn : ∀ᶠ k : ℕ in atTop, 0 < n k) (heps : ∀ᶠ k : ℕ in atTop, 0 < eps k ∧ eps k ≤ 1) (hepslow : ∀ᶠ k : ℕ in atTop, (k : ℝ) ^ (-D) ≤ eps k) (hnupper : ∀ᶠ k : ℕ in atTop, (n k : ℝ) ≤ C * (k : ℝ) ^ r) : Tendsto (fun k : ℕ ↦ (5 * eps k + (n k : ℝ) * log (4 * n k / eps k)) / k) atTop (𝓝 0) := by have hlim : Tendsto (fun k : ℕ ↦ (5 + C * (k : ℝ) ^ r * (log (4 * C) + (r + D) * log k)) / k) atTop (𝓝 0) := by convert (tendsto_const_div_atTop_nhds_zero_nat (5 : ℝ)).add ((tendsto_rpow_affine_log_div_nat hr (log (4 * C)) (r + D)).const_mul C) using 1 · ext k ring · ring apply squeeze_zero' _ _ hlim · filter_upwards [eventually_gt_atTop 0, hn, heps, hepslow, hnupper] with k hk hn he hl hu exact div_nonneg (broad_count_cost_polynomial_bound hk hn hC he.1 he.2 hl hu).1 (Nat.cast_nonneg k) · filter_upwards [eventually_gt_atTop 0, hn, heps, hepslow, hnupper] with k hk hn he hl hu exact div_le_div_of_nonneg_right (broad_count_cost_polynomial_bound hk hn hC he.1 he.2 hl hu).2 (Nat.cast_nonneg k) end Erdos859Verification end /- Inlined development module: PrimeCountZeroCost.lean -/ section /- Actual good prime-subset events with a sublinear prescribed count have zero exponential cost, once their independent-mark failure margin is controlled. -/ namespace Erdos859Verification open Finset Real Filter open scoped Topology noncomputable def primeTiltGoodCountMass (P : Finset ℕ) (lam : ℝ) (n : ℕ) (Good : Finset ℕ → Prop) : ℝ := by classical exact ∑ T ∈ P.powerset.filter (fun T ↦ T.card = n ∧ Good T), primeTiltWeight P lam T theorem primeTiltGoodCountMass_le_one {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (n : ℕ) (Good : Finset ℕ → Prop) : primeTiltGoodCountMass P lam n Good ≤ 1 := by classical calc _ ≤ ∑ T ∈ P.powerset, primeTiltWeight P lam T := sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun T _ _ ↦ (primeTiltWeight_pos hP hlam T).le) _ = 1 := sum_primeTiltWeight hP hlam theorem primeTilt_broad_good_count_exp_lower {lam v eps : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hv : log 2 ≤ v) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * mertensErrorConstant ≤ eps * v) {n : ℕ} (hn : 0 < n) (Good : Finset ℕ → Prop) [DecidablePred Good] {beta eta : ℝ} (heta : 0 ≤ eta) (hmargin : eta ≤ 1 - beta - (n : ℝ) ^ 2 * (16 * exp (-v) / eps)) (hbad : (∑ x : Fin n → primeLogWindow v ((1 + eps) * v), primeIntensityTupleWeight lam x * (if Good (tupleSupport x) then 0 else 1)) ≤ beta) : eta * exp (-(5 * eps + (n : ℝ) * log (4 * n / eps))) ≤ primeTiltGoodCountMass (primeLogWindow v ((1 + eps) * v)) lam n Good := by classical have hc := mul_le_mul_of_nonneg_left (broad_count_cost_lower heps hn) heta have h := primeTilt_broad_good_count_lower hlam hlam2 hv heps heps1 hlarge n Good heta hmargin hbad have heq : eta * (exp (-5 * eps) * (eps / 4) ^ n / (n.factorial : ℝ)) = eta * exp (-5 * eps) * (eps / 4) ^ n / (n.factorial : ℝ) := by ring rw [heq] at hc have hmass : primeTiltGoodCountMass (primeLogWindow v ((1 + eps) * v)) lam n Good = ∑ T ∈ (primeLogWindow v ((1 + eps) * v)).powerset.filter (fun T ↦ T.card = n ∧ Good T), primeTiltWeight (primeLogWindow v ((1 + eps) * v)) lam T := by unfold primeTiltGoodCountMass apply sum_congr · ext T simp only [mem_filter] · intro T _ rfl rw [hmass] have he : -(5 * eps + (n : ℝ) * log (4 * n / eps)) = -5 * eps - (n : ℝ) * log (4 * n / eps) := by ring rw [he] exact hc.trans h theorem tendsto_neg_log_div_of_exponential_lower {p cost : ℕ → ℝ} {eta : ℝ} (heta : 0 < eta) (hlower : ∀ᶠ k : ℕ in atTop, eta * exp (-cost k) ≤ p k) (hupper : ∀ᶠ k : ℕ in atTop, p k ≤ 1) (hcost : Tendsto (fun k : ℕ ↦ cost k / k) atTop (𝓝 0)) : Tendsto (fun k : ℕ ↦ -log (p k) / k) atTop (𝓝 0) := by have hlim : Tendsto (fun k : ℕ ↦ -log eta / k + cost k / k) atTop (𝓝 0) := by simpa using (tendsto_const_div_atTop_nhds_zero_nat (-log eta)).add hcost apply squeeze_zero' _ _ hlim · filter_upwards [hlower, hupper] with k hlo hhi have hp : 0 < p k := (mul_pos heta (exp_pos _)).trans_le hlo exact div_nonneg (neg_nonneg.mpr (log_nonpos hp.le hhi)) (Nat.cast_nonneg k) · filter_upwards [hlower] with k hlo have hp : 0 < p k := (mul_pos heta (exp_pos _)).trans_le hlo have hlog := log_le_log (mul_pos heta (exp_pos _)) hlo rw [log_mul heta.ne' (exp_pos _).ne', log_exp] at hlog have h := div_le_div_of_nonneg_right (neg_le_neg hlog) (Nat.cast_nonneg k) simpa only [neg_add, neg_neg, add_div] using h theorem primeTilt_broad_good_count_zero_exponential_cost {lam eta C D r : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (heta : 0 < eta) (hC : 0 < C) (hr : r < 1) (v eps beta : ℕ → ℝ) (n : ℕ → ℕ) (Good : ℕ → Finset ℕ → Prop) [∀ k, DecidablePred (Good k)] (hv : ∀ᶠ k : ℕ in atTop, log 2 ≤ v k) (heps : ∀ᶠ k : ℕ in atTop, 0 < eps k ∧ eps k ≤ 1) (hlarge : ∀ᶠ k : ℕ in atTop, 8 * mertensErrorConstant ≤ eps k * v k) (hn : ∀ᶠ k : ℕ in atTop, 0 < n k) (hepslow : ∀ᶠ k : ℕ in atTop, (k : ℝ) ^ (-D) ≤ eps k) (hnupper : ∀ᶠ k : ℕ in atTop, (n k : ℝ) ≤ C * (k : ℝ) ^ r) (hmargin : ∀ᶠ k : ℕ in atTop, eta ≤ 1 - beta k - (n k : ℝ) ^ 2 * (16 * exp (-v k) / eps k)) (hbad : ∀ᶠ k : ℕ in atTop, (∑ x : Fin (n k) → primeLogWindow (v k) ((1 + eps k) * v k), primeIntensityTupleWeight lam x * (if Good k (tupleSupport x) then 0 else 1)) ≤ beta k) : Tendsto (fun k : ℕ ↦ -log (primeTiltGoodCountMass (primeLogWindow (v k) ((1 + eps k) * v k)) lam (n k) (Good k)) / k) atTop (𝓝 0) := by classical apply tendsto_neg_log_div_of_exponential_lower heta (cost := fun k ↦ 5 * eps k + (n k : ℝ) * log (4 * n k / eps k)) · filter_upwards [hv, heps, hlarge, hn, hmargin, hbad] with k hv he hl hn hm hb exact primeTilt_broad_good_count_exp_lower hlam hlam2 hv he.1 he.2 hl hn (Good k) heta.le hm hb · exact Eventually.of_forall fun k ↦ primeTiltGoodCountMass_le_one (fun p hp ↦ (mem_primeLogWindow.mp hp).1) (zero_lt_one.trans_le hlam) (n k) (Good k) · exact tendsto_broad_count_cost_div hC hr hn heps hepslow hnupper end Erdos859Verification end /- Inlined development module: HighPrimeCount.lean -/ section /- The concrete sublinear number of final high-prime marks. -/ namespace Erdos859Verification open Real Filter open scoped Topology noncomputable def highPrimeCount (k : ℕ) : ℕ := ⌈(k : ℝ) ^ ((3 : ℝ) / 4)⌉₊ theorem highPrimeCount_bounds {k : ℕ} (hk : 0 < k) : 0 < highPrimeCount k ∧ (highPrimeCount k : ℝ) ≤ 2 * (k : ℝ) ^ ((3 : ℝ) / 4) := by have hkR : (1 : ℝ) ≤ k := by exact_mod_cast hk have hp : 0 < (k : ℝ) ^ ((3 : ℝ) / 4) := rpow_pos_of_pos (by linarith) _ have hp1 : 1 ≤ (k : ℝ) ^ ((3 : ℝ) / 4) := one_le_rpow hkR (by norm_num) constructor · exact Nat.one_le_ceil_iff.mpr hp · have h := Nat.ceil_lt_add_one hp.le change (⌈(k : ℝ) ^ ((3 : ℝ) / 4)⌉₊ : ℝ) ≤ _ linarith theorem highPrimeCount_zero_count_cost {eps : ℕ → ℝ} {D : ℝ} (heps : ∀ᶠ k : ℕ in atTop, 0 < eps k ∧ eps k ≤ 1) (hepslow : ∀ᶠ k : ℕ in atTop, (k : ℝ) ^ (-D) ≤ eps k) : Tendsto (fun k : ℕ ↦ (5 * eps k + (highPrimeCount k : ℝ) * log (4 * highPrimeCount k / eps k)) / k) atTop (𝓝 0) := by apply tendsto_broad_count_cost_div (C := 2) (r := (3 : ℝ) / 4) (by norm_num) (by norm_num) _ heps hepslow · filter_upwards [eventually_gt_atTop 0] with k hk exact (highPrimeCount_bounds hk).2 · filter_upwards [eventually_gt_atTop 0] with k hk exact (highPrimeCount_bounds hk).1 end Erdos859Verification end /- Inlined development module: IndependentPrimePhase.lean -/ section /- Finite independent mark products and rational denominator union bounds. -/ namespace Erdos859Verification open Finset Real /-- A conjunction of coordinate events factors under the finite product law. -/ theorem finite_product_conjunction_eq {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} [∀ i, Fintype (α i)] (weight : ∀ i, α i → ℝ) (E : ∀ i, α i → Prop) [∀ i, DecidablePred (E i)] : (∑ x : ∀ i, α i, finiteProductWeight weight x * (if ∀ i, E i (x i) then 1 else 0)) = ∏ i, ∑ y, weight i y * (if E i y then 1 else 0) := by classical unfold finiteProductWeight simp_rw [← Fintype.prod_boole, ← prod_mul_distrib] exact (Fintype.prod_sum (fun i y ↦ weight i y * (if E i y then 1 else 0))).symm theorem finite_product_conjunction_le {ι : Type*} [Fintype ι] [DecidableEq ι] {α : ι → Type*} [∀ i, Fintype (α i)] (weight : ∀ i, α i → ℝ) (E : ∀ i, α i → Prop) [∀ i, DecidablePred (E i)] (bound : ι → ℝ) (hw : ∀ i y, 0 ≤ weight i y) (hbound : ∀ i, (∑ y, weight i y * (if E i y then 1 else 0)) ≤ bound i) : (∑ x : ∀ i, α i, finiteProductWeight weight x * (if ∀ i, E i (x i) then 1 else 0)) ≤ ∏ i, bound i := by rw [finite_product_conjunction_eq] exact prod_le_prod (fun i _ ↦ sum_nonneg (fun y _ ↦ mul_nonneg (hw i y) (by split_ifs <;> norm_num))) (fun i _ ↦ hbound i) /-- The coordinate sets and laws may differ. Normalization is unnecessary for this weighted estimate; normalized weights give its probability form. -/ theorem independent_prime_residue_conjunction_le {m : ℕ} (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (hw : ∀ i p, p ∈ P i → 0 ≤ weight i p) {q a : ℕ} (hcop : Nat.Coprime a q) (S : Finset (Fin q)) {B : ℝ} (hB : 0 ≤ B) (hres : ∀ i r, (∑ p ∈ (P i).filter (fun p ↦ Nat.ModEq q p r), weight i p) ≤ B) : (∑ x : (i : Fin m) → P i, finiteProductWeight (fun i p ↦ weight i p.val) x * (if ∀ i, ∃ r ∈ S, Nat.ModEq q ((x i).val * a) r.val then 1 else 0)) ≤ ((S.card : ℝ) * B) ^ m := by classical have h := finite_product_conjunction_le (fun i (p : P i) ↦ weight i p.val) (fun i (p : P i) ↦ ∃ r ∈ S, Nat.ModEq q (p.val * a) r.val) (fun _ ↦ (S.card : ℝ) * B) (fun i p ↦ hw i p.val p.property) (by intro i have hi := finite_weighted_mul_residues_le (P i) (weight i) hcop hB (hw i) (hres i) S rw [sum_coe_sort (P i) (fun p ↦ weight i p * (if ∃ r ∈ S, Nat.ModEq q (p * a) r.val then 1 else 0))] simpa only [sum_filter, mul_ite, mul_one, mul_zero] using hi) simp only [prod_const, card_univ, Fintype.card_fin] at h convert h using 1 apply sum_congr rfl intro x _ by_cases hx : ∀ i, ∃ r ∈ S, Nat.ModEq q ((x i).val * a) r.val · simp only [if_pos hx] · simp only [if_neg hx] /-- Sum the independent mark bound over all admissible reduced numerators and denominators. The cover may come from any deterministic phase argument. -/ theorem independent_prime_rational_union_bound {m : ℕ} (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (hw : ∀ i p, p ∈ P i → 0 ≤ weight i p) (J : Finset ℕ) (S : ∀ q, Finset (Fin q)) (C B : ℕ → ℝ) (hB : ∀ q ∈ J, 0 ≤ B q) (hcard : ∀ q ∈ J, ((S q).card : ℝ) ≤ C q) (hres : ∀ i q, q ∈ J → ∀ r, (∑ p ∈ (P i).filter (fun p ↦ Nat.ModEq q p r), weight i p) ≤ B q) (Bad : ((i : Fin m) → P i) → Prop) [DecidablePred Bad] (hcover : ∀ x, Bad x → ∃ q ∈ J, ∃ a ∈ S q, Nat.Coprime a.val q ∧ ∀ i, ∃ r ∈ S q, Nat.ModEq q ((x i).val * a.val) r.val) : (∑ x : (i : Fin m) → P i, finiteProductWeight (fun i p ↦ weight i p.val) x * (if Bad x then 1 else 0)) ≤ ∑ q ∈ J, C q * (C q * B q) ^ m := by classical let E : (Sigma Fin) → ((i : Fin m) → P i) → Prop := fun qa x ↦ Nat.Coprime qa.2.val qa.1 ∧ ∀ i, ∃ r ∈ S qa.1, Nat.ModEq qa.1 ((x i).val * qa.2.val) r.val have hwprod (x : (i : Fin m) → P i) : 0 ≤ finiteProductWeight (fun i p ↦ weight i p.val) x := finiteProductWeight_nonneg (fun i p ↦ hw i p.val p.property) x have hC (q : ℕ) (hq : q ∈ J) : 0 ≤ C q := (Nat.cast_nonneg _).trans (hcard q hq) have hpair (qa : Sigma Fin) (hqa : qa ∈ J.sigma S) : (∑ x : (i : Fin m) → P i, finiteProductWeight (fun i p ↦ weight i p.val) x * (if E qa x then 1 else 0)) ≤ (C qa.1 * B qa.1) ^ m := by have hq := (mem_sigma.mp hqa).1 by_cases hcop : Nat.Coprime qa.2.val qa.1 · have hr := (independent_prime_residue_conjunction_le P weight hw hcop (S qa.1) (hB qa.1 hq) (fun i r ↦ hres i qa.1 hq r)).trans (pow_le_pow_left₀ (mul_nonneg (Nat.cast_nonneg _) (hB qa.1 hq)) (mul_le_mul_of_nonneg_right (hcard qa.1 hq) (hB qa.1 hq)) m) have heq : (∑ x : (i : Fin m) → P i, finiteProductWeight (fun i p ↦ weight i p.val) x * (if E qa x then 1 else 0)) = ∑ x : (i : Fin m) → P i, finiteProductWeight (fun i p ↦ weight i p.val) x * (if ∀ i, ∃ r ∈ S qa.1, Nat.ModEq qa.1 ((x i).val * qa.2.val) r.val then 1 else 0) := by apply sum_congr rfl intro x _ have he : E qa x ↔ ∀ i, ∃ r ∈ S qa.1, Nat.ModEq qa.1 ((x i).val * qa.2.val) r.val := and_iff_right hcop simp only [he] rw [heq] exact hr · simp only [E, hcop, false_and, if_false, mul_zero, sum_const_zero] exact pow_nonneg (mul_nonneg (hC qa.1 hq) (hB qa.1 hq)) m calc _ ≤ ∑ x : (i : Fin m) → P i, finiteProductWeight (fun i p ↦ weight i p.val) x * (if ∃ qa ∈ J.sigma S, E qa x then 1 else 0) := by apply sum_le_sum intro x _ apply mul_le_mul_of_nonneg_left _ (hwprod x) by_cases hx : Bad x · obtain ⟨q, hq, a, ha, hcop, hmarks⟩ := hcover x hx have he : ∃ qa ∈ J.sigma S, E qa x := ⟨⟨q, a⟩, mem_sigma.mpr ⟨hq, ha⟩, hcop, hmarks⟩ simp only [if_pos hx, if_pos he, le_refl] · simp only [if_neg hx] split_ifs <;> norm_num _ ≤ ∑ qa ∈ J.sigma S, ∑ x : (i : Fin m) → P i, finiteProductWeight (fun i p ↦ weight i p.val) x * (if E qa x then 1 else 0) := finite_weighted_union_bound_general univ (J.sigma S) (finiteProductWeight (fun i p ↦ weight i p.val)) (fun x _ ↦ hwprod x) E _ ≤ ∑ qa ∈ J.sigma S, (C qa.1 * B qa.1) ^ m := sum_le_sum hpair _ = ∑ q ∈ J, ((S q).card : ℝ) * (C q * B q) ^ m := by rw [sum_sigma] simp _ ≤ _ := sum_le_sum (fun q hq ↦ mul_le_mul_of_nonneg_right (hcard q hq) (pow_nonneg (mul_nonneg (hC q hq) (hB q hq)) m)) /-- Proper cubes give the concrete numerator and residue count required by the independent union bound. -/ theorem proper_cube_independent_rational_union_bound {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) {Y : ℝ} (hY : 0 < Y) (hYH : 32 * (H : ℝ) ≤ Y) (hW : 0 < ∑ i, w i) (hscale : 2 ≤ Y * ∑ i, (w i : ℝ)) {m : ℕ} (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (hw : ∀ i p, p ∈ P i → 0 ≤ weight i p) (J : Finset ℕ) (hq : ∀ q ∈ J, 0 < q) (S : ∀ q, Finset (Fin q)) (hS : ∀ q ∈ J, ∀ a ∈ S q, ∃ x : AddCircle (1 : ℝ), cubePhaseSquare w x ≤ (1 / Y) ^ 2 ∧ dist (circleRationalGridPoint q a) x ≤ 1 / (q : ℝ)) (B : ℕ → ℝ) (hB : ∀ q ∈ J, 0 ≤ B q) (hres : ∀ i q, q ∈ J → ∀ r, (∑ p ∈ (P i).filter (fun p ↦ Nat.ModEq q p r), weight i p) ≤ B q) (Bad : ((i : Fin m) → P i) → Prop) [DecidablePred Bad] (hcover : ∀ x, Bad x → ∃ q ∈ J, ∃ a ∈ S q, Nat.Coprime a.val q ∧ ∀ i, ∃ r ∈ S q, Nat.ModEq q ((x i).val * a.val) r.val) : (∑ x : (i : Fin m) → P i, finiteProductWeight (fun i p ↦ weight i p.val) x * (if Bad x then 1 else 0)) ≤ ∑ q ∈ J, (6 * ((q : ℝ) + Y * ∑ i, (w i : ℝ)) / (2 * (H : ℝ) + 1) ^ Fintype.card ι) * ((6 * ((q : ℝ) + Y * ∑ i, (w i : ℝ)) / (2 * (H : ℝ) + 1) ^ Fintype.card ι) * B q) ^ m := by exact independent_prime_rational_union_bound P weight hw J S _ B hB (fun q hqJ ↦ proper_cube_near_grid_card_le w hproper hY hYH hW hscale (hq q hqJ) (S q) (hS q hqJ)) hres Bad hcover /-- The numerical denominator sum on one multiplicative block. Allowing real endpoints also covers blocks starting at a nonintegral anchor. -/ theorem rational_phase_block_sum_le {Q R M G Pmin : ℝ} (hQ : 0 < Q) (hR : 0 ≤ R) (hM : 0 < M) (hG : 0 ≤ G) (hPmin : 0 < Pmin) {m : ℕ} (hm : 1 ≤ m) (J : Finset ℕ) (hcard : (J.card : ℝ) ≤ 2 * Q) (hrange : ∀ q ∈ J, Q ≤ (q : ℝ) ∧ (q : ℝ) ≤ 2 * Q) : (∑ q ∈ J, (6 * ((q : ℝ) + R) / M) * ((6 * ((q : ℝ) + R) / M) * (G / (q : ℝ) * (1 + (q : ℝ) / Pmin))) ^ m) ≤ 12 * (6 * G) ^ m * (1 + 2 * Q / Pmin) ^ m * (2 * Q + R) ^ (m + 1) / (M ^ (m + 1) * Q ^ (m - 1)) := by have hC0 : 0 ≤ 6 * (2 * Q + R) / M := by positivity have hB0 : 0 ≤ G / Q * (1 + 2 * Q / Pmin) := by positivity have hterm (q : ℕ) (hq : q ∈ J) : (6 * ((q : ℝ) + R) / M) * ((6 * ((q : ℝ) + R) / M) * (G / (q : ℝ) * (1 + (q : ℝ) / Pmin))) ^ m ≤ (6 * (2 * Q + R) / M) * ((6 * (2 * Q + R) / M) * (G / Q * (1 + 2 * Q / Pmin))) ^ m := by have hC : 6 * ((q : ℝ) + R) / M ≤ 6 * (2 * Q + R) / M := by gcongr exact (hrange q hq).2 have hB : G / (q : ℝ) * (1 + (q : ℝ) / Pmin) ≤ G / Q * (1 + 2 * Q / Pmin) := by apply mul_le_mul (div_le_div_of_nonneg_left hG hQ (hrange q hq).1) (add_le_add le_rfl (div_le_div_of_nonneg_right (hrange q hq).2 hPmin.le)) (by positivity) (by positivity) have hmul := mul_le_mul hC hB (by positivity) hC0 exact mul_le_mul hC (pow_le_pow_left₀ (by positivity) hmul m) (by positivity) hC0 calc _ ≤ ∑ _q ∈ J, (6 * (2 * Q + R) / M) * ((6 * (2 * Q + R) / M) * (G / Q * (1 + 2 * Q / Pmin))) ^ m := sum_le_sum hterm _ = (J.card : ℝ) * ((6 * (2 * Q + R) / M) * ((6 * (2 * Q + R) / M) * (G / Q * (1 + 2 * Q / Pmin))) ^ m) := by simp _ ≤ (2 * Q) * ((6 * (2 * Q + R) / M) * ((6 * (2 * Q + R) / M) * (G / Q * (1 + 2 * Q / Pmin))) ^ m) := mul_le_mul_of_nonneg_right hcard (mul_nonneg hC0 (pow_nonneg (mul_nonneg hC0 hB0) m)) _ = _ := by cases m with | zero => omega | succ n => simp only [Nat.add_sub_cancel, pow_succ, mul_pow, div_pow] field_simp ring theorem nat_dyadic_interval_card_le {Q : ℕ} (hQ : 0 < Q) : ((Icc Q (2 * Q)).card : ℝ) ≤ 2 * (Q : ℝ) := by have h : (Icc Q (2 * Q)).card ≤ 2 * Q := by rw [Nat.card_Icc]; omega exact_mod_cast h /-- The rational union bound with its uniform block prefactor 12. -/ theorem independent_prime_rational_block_bound {m : ℕ} (hm : 1 ≤ m) (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (hw : ∀ i p, p ∈ P i → 0 ≤ weight i p) {Q R M G Pmin : ℝ} (hQ : 0 < Q) (hR : 0 ≤ R) (hM : 0 < M) (hG : 0 ≤ G) (hPmin : 0 < Pmin) (J : Finset ℕ) (hJcard : (J.card : ℝ) ≤ 2 * Q) (hrange : ∀ q ∈ J, Q ≤ (q : ℝ) ∧ (q : ℝ) ≤ 2 * Q) (S : ∀ q, Finset (Fin q)) (hcard : ∀ q ∈ J, ((S q).card : ℝ) ≤ 6 * ((q : ℝ) + R) / M) (hres : ∀ i q, q ∈ J → ∀ r, (∑ p ∈ (P i).filter (fun p ↦ Nat.ModEq q p r), weight i p) ≤ G / (q : ℝ) * (1 + (q : ℝ) / Pmin)) (Bad : ((i : Fin m) → P i) → Prop) [DecidablePred Bad] (hcover : ∀ x, Bad x → ∃ q ∈ J, ∃ a ∈ S q, Nat.Coprime a.val q ∧ ∀ i, ∃ r ∈ S q, Nat.ModEq q ((x i).val * a.val) r.val) : (∑ x : (i : Fin m) → P i, finiteProductWeight (fun i p ↦ weight i p.val) x * (if Bad x then 1 else 0)) ≤ 12 * (6 * G) ^ m * (1 + 2 * Q / Pmin) ^ m * (2 * Q + R) ^ (m + 1) / (M ^ (m + 1) * Q ^ (m - 1)) := by exact (independent_prime_rational_union_bound P weight hw J S (fun q ↦ 6 * ((q : ℝ) + R) / M) (fun q ↦ G / (q : ℝ) * (1 + (q : ℝ) / Pmin)) (fun _ _ ↦ by positivity) hcard hres Bad hcover).trans (rational_phase_block_sum_le hQ hR hM hG hPmin hm J hJcard hrange) end Erdos859Verification end /- Inlined development module: RationalPhaseCoverage.lean -/ section /- Deterministic coverage of real phase arcs by finite rational residue events. -/ namespace Erdos859Verification open Finset Real noncomputable def circleNearGrid (F : Set (AddCircle (1 : ℝ))) (q : ℕ) : Finset (Fin q) := by classical exact univ.filter (fun a ↦ ∃ x ∈ F, dist (circleRationalGridPoint q a) x ≤ 1 / (q : ℝ)) theorem mem_circleNearGrid {F : Set (AddCircle (1 : ℝ))} {q : ℕ} {a : Fin q} : a ∈ circleNearGrid F q ↔ ∃ x ∈ F, dist (circleRationalGridPoint q a) x ≤ 1 / (q : ℝ) := by classical simp only [circleNearGrid, mem_filter, mem_univ, true_and] def circleGridMul {q : ℕ} (hq : 0 < q) (p : ℕ) (a : Fin q) : Fin q := ⟨(p * a.val) % q, Nat.mod_lt _ hq⟩ theorem circleRationalGridPoint_mul {q : ℕ} (hq : 0 < q) (p : ℕ) (a : Fin q) : circleRationalGridPoint q (circleGridMul hq p a) = p • circleRationalGridPoint q a := by unfold circleRationalGridPoint circleGridMul rw [← mul_nsmul] have h := mod_addOrderOf_nsmul (((1 : ℝ) / q : ℝ) : AddCircle (1 : ℝ)) (p * a.val) rw [AddCircle.addOrderOf_period_div hq] at h simpa only [Nat.mul_comm] using h theorem circleGridMul_modEq {q : ℕ} (hq : 0 < q) (p : ℕ) (a : Fin q) : Nat.ModEq q (p * a.val) (circleGridMul hq p a).val := by change (p * a.val) % q = ((p * a.val) % q) % q rw [Nat.mod_mod] theorem unitCircle_dist_nsmul_le (p : ℕ) (x y : AddCircle (1 : ℝ)) : dist (p • x) (p • y) ≤ (p : ℝ) * dist x y := by rw [dist_eq_norm, dist_eq_norm, ← nsmul_sub] exact norm_nsmul_le theorem mem_circleNearGrid_of_arc {F : Set (AddCircle (1 : ℝ))} {U : ℝ} (hU : 1 ≤ U) {q : ℕ} (hq : 0 < q) (a : Fin q) {alpha : AddCircle (1 : ℝ)} (halpha : alpha ∈ F) (harc : dist alpha (circleRationalGridPoint q a) ≤ 1 / ((q : ℝ) * U)) : a ∈ circleNearGrid F q := by have hqR : (0 : ℝ) < q := by exact_mod_cast hq apply mem_circleNearGrid.mpr refine ⟨alpha, halpha, ?_⟩ rw [dist_comm] apply harc.trans apply one_div_le_one_div_of_le hqR nlinarith theorem circleGridMul_mem_circleNearGrid_of_arc {F : Set (AddCircle (1 : ℝ))} {U : ℝ} (hU : 1 ≤ U) {q : ℕ} (hq : 0 < q) (a : Fin q) {p : ℕ} (hp : (p : ℝ) ≤ U) {alpha : AddCircle (1 : ℝ)} (hpalpha : p • alpha ∈ F) (harc : dist alpha (circleRationalGridPoint q a) ≤ 1 / ((q : ℝ) * U)) : circleGridMul hq p a ∈ circleNearGrid F q := by have hqR : (0 : ℝ) < q := by exact_mod_cast hq have hU0 : 0 < U := by linarith apply mem_circleNearGrid.mpr refine ⟨p • alpha, hpalpha, ?_⟩ rw [circleRationalGridPoint_mul] calc _ ≤ (p : ℝ) * dist (circleRationalGridPoint q a) alpha := unitCircle_dist_nsmul_le _ _ _ _ ≤ (p : ℝ) * (1 / ((q : ℝ) * U)) := mul_le_mul_of_nonneg_left (by simpa only [dist_comm] using harc) (Nat.cast_nonneg p) _ ≤ U * (1 / ((q : ℝ) * U)) := mul_le_mul_of_nonneg_right hp (by positivity) _ = 1 / (q : ℝ) := by field_simp def primePhaseArcEvent {m : ℕ} {P : Fin m → Finset ℕ} (F : Set (AddCircle (1 : ℝ))) (J : Finset ℕ) (U : ℝ) (x : (i : Fin m) → P i) : Prop := ∃ alpha ∈ F, ∃ q ∈ J, ∃ a : Fin q, Nat.Coprime a.val q ∧ dist alpha (circleRationalGridPoint q a) ≤ 1 / ((q : ℝ) * U) ∧ ∀ i, (x i).val • alpha ∈ F theorem primePhaseArcEvent_residue_cover {m : ℕ} (P : Fin m → Finset ℕ) (F : Set (AddCircle (1 : ℝ))) (J : Finset ℕ) {U : ℝ} (hU : 1 ≤ U) (hq : ∀ q ∈ J, 0 < q) (hP : ∀ i p, p ∈ P i → (p : ℝ) ≤ U) (x : (i : Fin m) → P i) (hx : primePhaseArcEvent F J U x) : ∃ q ∈ J, ∃ a ∈ circleNearGrid F q, Nat.Coprime a.val q ∧ ∀ i, ∃ r ∈ circleNearGrid F q, Nat.ModEq q ((x i).val * a.val) r.val := by obtain ⟨alpha, halpha, q, hqJ, a, hcop, harc, hmarks⟩ := hx refine ⟨q, hqJ, a, mem_circleNearGrid_of_arc hU (hq q hqJ) a halpha harc, hcop, ?_⟩ intro i exact ⟨circleGridMul (hq q hqJ) (x i).val a, circleGridMul_mem_circleNearGrid_of_arc hU (hq q hqJ) a (hP i (x i).val (x i).property) (hmarks i) harc, circleGridMul_modEq (hq q hqJ) (x i).val a⟩ noncomputable def independentPrimePhaseArcMass {m : ℕ} (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (F : Set (AddCircle (1 : ℝ))) (J : Finset ℕ) (U : ℝ) : ℝ := by classical exact ∑ x : (i : Fin m) → P i, finiteProductWeight (fun i p ↦ weight i p.val) x * (if primePhaseArcEvent F J U x then 1 else 0) theorem independentPrimePhaseArcMass_le {m : ℕ} (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (hw : ∀ i p, p ∈ P i → 0 ≤ weight i p) (F : Set (AddCircle (1 : ℝ))) (J : Finset ℕ) {U : ℝ} (hU : 1 ≤ U) (hq : ∀ q ∈ J, 0 < q) (hP : ∀ i p, p ∈ P i → (p : ℝ) ≤ U) (C B : ℕ → ℝ) (hB : ∀ q ∈ J, 0 ≤ B q) (hcard : ∀ q ∈ J, ((circleNearGrid F q).card : ℝ) ≤ C q) (hres : ∀ i q, q ∈ J → ∀ r, (∑ p ∈ (P i).filter (fun p ↦ Nat.ModEq q p r), weight i p) ≤ B q) : independentPrimePhaseArcMass P weight F J U ≤ ∑ q ∈ J, C q * (C q * B q) ^ m := by classical exact independent_prime_rational_union_bound P weight hw J (circleNearGrid F) C B hB hcard hres (primePhaseArcEvent F J U) (primePhaseArcEvent_residue_cover P F J hU hq hP) theorem proper_cube_independentPhaseArcMass_le {ι : Type*} [Fintype ι] (w : ι → ℕ) {H : ℕ} (hproper : IsProperSignedCube w H) {Y : ℝ} (hY : 0 < Y) (hYH : 32 * (H : ℝ) ≤ Y) (hW : 0 < ∑ i, w i) (hscale : 2 ≤ Y * ∑ i, (w i : ℝ)) {m : ℕ} (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (hw : ∀ i p, p ∈ P i → 0 ≤ weight i p) (J : Finset ℕ) {U : ℝ} (hU : 1 ≤ U) (hq : ∀ q ∈ J, 0 < q) (hP : ∀ i p, p ∈ P i → (p : ℝ) ≤ U) (B : ℕ → ℝ) (hB : ∀ q ∈ J, 0 ≤ B q) (hres : ∀ i q, q ∈ J → ∀ r, (∑ p ∈ (P i).filter (fun p ↦ Nat.ModEq q p r), weight i p) ≤ B q) : independentPrimePhaseArcMass P weight {alpha | cubePhaseSquare w alpha ≤ (1 / Y) ^ 2} J U ≤ ∑ q ∈ J, (6 * ((q : ℝ) + Y * ∑ i, (w i : ℝ)) / (2 * (H : ℝ) + 1) ^ Fintype.card ι) * ((6 * ((q : ℝ) + Y * ∑ i, (w i : ℝ)) / (2 * (H : ℝ) + 1) ^ Fintype.card ι) * B q) ^ m := by apply independentPrimePhaseArcMass_le P weight hw _ J hU hq hP _ B hB _ hres intro q hqJ exact proper_cube_near_grid_card_le w hproper hY hYH hW hscale (hq q hqJ) _ (fun _ ha ↦ mem_circleNearGrid.mp ha) /-- Dirichlet approximation with a reduced numerator in the canonical circle grid. The denominator is positive and bounded by the integer horizon. -/ theorem unitCircle_exists_reduced_grid_approx (alpha : AddCircle (1 : ℝ)) {U : ℕ} (hU : 0 < U) : ∃ q : ℕ, 0 < q ∧ q ≤ U ∧ ∃ a : Fin q, Nat.Coprime a.val q ∧ dist alpha (circleRationalGridPoint q a) ≤ 1 / ((q : ℝ) * (U : ℝ)) := by obtain ⟨xi, rfl⟩ := QuotientAddGroup.mk_surjective alpha obtain ⟨r, hr, hrU⟩ := Real.exists_rat_abs_sub_le_and_den_le xi hU have hord : addOrderOf (((r : ℝ) : AddCircle (1 : ℝ))) = r.den := by simpa only [mul_one] using (AddCircle.addOrderOf_coe_rat (p := (1 : ℝ)) (q := r)) obtain ⟨a, ha, hcop, heq⟩ := (AddCircle.addOrderOf_eq_pos_iff r.pos).mp hord refine ⟨r.den, r.pos, hrU, ⟨a, ha⟩, hcop, ?_⟩ have hgrid : circleRationalGridPoint r.den ⟨a, ha⟩ = ((r : ℝ) : AddCircle (1 : ℝ)) := by simpa only [circleRationalGridPoint_eq_div, mul_one] using heq rw [hgrid] have hqR : (0 : ℝ) < r.den := by exact_mod_cast r.pos have hUR : (0 : ℝ) < U := by exact_mod_cast hU calc _ ≤ |xi - (r : ℝ)| := by rw [dist_eq_norm, ← AddCircle.coe_sub] exact QuotientAddGroup.norm_mk_le_norm _ ≤ 1 / (((U : ℝ) + 1) * (r.den : ℝ)) := hr _ ≤ _ := one_div_le_one_div_of_le (mul_pos hqR hUR) (by nlinarith) theorem unitCircle_exists_nontrivial_reduced_grid_approx (alpha : AddCircle (1 : ℝ)) {U : ℕ} (hU : 0 < U) (hfar : 1 / (U : ℝ) < ‖alpha‖) : ∃ q : ℕ, 2 ≤ q ∧ q ≤ U ∧ ∃ a : Fin q, Nat.Coprime a.val q ∧ dist alpha (circleRationalGridPoint q a) ≤ 1 / ((q : ℝ) * (U : ℝ)) := by obtain ⟨q, hq, hqU, a, hcop, harc⟩ := unitCircle_exists_reduced_grid_approx alpha hU have hq2 : 2 ≤ q := by by_contra hn have hq1 : q = 1 := by omega have ha : a.val = 0 := by have := a.isLt; omega have hg : circleRationalGridPoint q a = 0 := by simp [circleRationalGridPoint, ha] rw [hg, dist_zero_right, hq1] at harc simp only [Nat.cast_one, one_mul] at harc exact (not_le_of_gt hfar) harc exact ⟨q, hq2, hqU, a, hcop, harc⟩ /-- Every phase outside the allowed zero neighborhood is covered by the finite family of nontrivial reduced rational arcs. -/ theorem primePhaseArcEvent_of_far_phase {m : ℕ} {P : Fin m → Finset ℕ} (F : Set (AddCircle (1 : ℝ))) {U : ℕ} (hU : 0 < U) (x : (i : Fin m) → P i) {alpha : AddCircle (1 : ℝ)} (halpha : alpha ∈ F) (hfar : 1 / (U : ℝ) < ‖alpha‖) (hmarks : ∀ i, (x i).val • alpha ∈ F) : primePhaseArcEvent F (Icc 2 U) (U : ℝ) x := by obtain ⟨q, hq, hqU, a, hcop, harc⟩ := unitCircle_exists_nontrivial_reduced_grid_approx alpha hU hfar exact ⟨alpha, halpha, q, mem_Icc.mpr ⟨hq, hqU⟩, a, hcop, harc, hmarks⟩ def primeFarPhaseEvent {m : ℕ} {P : Fin m → Finset ℕ} (F : Set (AddCircle (1 : ℝ))) (U : ℝ) (x : (i : Fin m) → P i) : Prop := ∃ alpha ∈ F, 1 / U < ‖alpha‖ ∧ ∀ i, (x i).val • alpha ∈ F noncomputable def independentPrimeFarPhaseMass {m : ℕ} (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (F : Set (AddCircle (1 : ℝ))) (U : ℝ) : ℝ := by classical exact ∑ x : (i : Fin m) → P i, finiteProductWeight (fun i p ↦ weight i p.val) x * (if primeFarPhaseEvent F U x then 1 else 0) theorem independentPrimeFarPhaseMass_le_arc {m : ℕ} (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (hw : ∀ i p, p ∈ P i → 0 ≤ weight i p) (F : Set (AddCircle (1 : ℝ))) {U : ℕ} (hU : 0 < U) : independentPrimeFarPhaseMass P weight F (U : ℝ) ≤ independentPrimePhaseArcMass P weight F (Icc 2 U) (U : ℝ) := by classical unfold independentPrimeFarPhaseMass independentPrimePhaseArcMass apply sum_le_sum intro x _ apply mul_le_mul_of_nonneg_left _ (finiteProductWeight_nonneg (fun i p ↦ hw i p.val p.property) x) by_cases hx : primeFarPhaseEvent F (U : ℝ) x · obtain ⟨alpha, halpha, hfar, hmarks⟩ := hx have ha := primePhaseArcEvent_of_far_phase F hU x halpha hfar hmarks rw [if_pos ⟨alpha, halpha, hfar, hmarks⟩, if_pos ha] · rw [if_neg hx] split_ifs <;> norm_num end Erdos859Verification end /- Inlined development module: SmallDenominatorPhase.lean -/ section /- The weight one excludes small denominators and bounds nearby grid residues. -/ namespace Erdos859Verification open Finset Real theorem reduced_grid_norm_lower {q : ℕ} (hq : 2 ≤ q) (a : Fin q) (hcop : Nat.Coprime a.val q) : 1 / (q : ℝ) ≤ ‖circleRationalGridPoint q a‖ := by have hq0 : 0 < q := by omega have ha : a.val ≠ 0 := by intro ha0 have hq1 : q = 1 := by simpa only [ha0, Nat.coprime_zero_left] using hcop omega have hne : a ≠ (⟨0, hq0⟩ : Fin q) := by intro h exact ha (congrArg Fin.val h) have h := circleRationalGridPoint_separated hq0 a ⟨0, hq0⟩ hne simpa only [circleRationalGridPoint, zero_smul, dist_zero_right] using h theorem norm_lower_of_reduced_arc {q : ℕ} (hq : 2 ≤ q) (a : Fin q) (hcop : Nat.Coprime a.val q) {U : ℝ} (hU : 0 < U) {alpha : AddCircle (1 : ℝ)} (harc : dist alpha (circleRationalGridPoint q a) ≤ 1 / ((q : ℝ) * U)) : (1 - 1 / U) / (q : ℝ) ≤ ‖alpha‖ := by have hqR : (0 : ℝ) < q := by exact_mod_cast (show 0 < q by omega) have hg := reduced_grid_norm_lower hq a hcop have ht := dist_triangle (circleRationalGridPoint q a) alpha 0 rw [dist_zero_right, dist_zero_right, dist_comm (circleRationalGridPoint q a) alpha] at ht have hid : (1 - 1 / U) / (q : ℝ) = 1 / (q : ℝ) - 1 / ((q : ℝ) * U) := by field_simp rw [hid] linarith theorem reduced_arc_denominator_gt_half {Y U : ℝ} (hY : 0 < Y) (hU : 2 < U) {q : ℕ} (hq : 2 ≤ q) (a : Fin q) (hcop : Nat.Coprime a.val q) {alpha : AddCircle (1 : ℝ)} (halpha : ‖alpha‖ ≤ 1 / Y) (harc : dist alpha (circleRationalGridPoint q a) ≤ 1 / ((q : ℝ) * U)) : Y / 2 < (q : ℝ) := by have hqR : (0 : ℝ) < q := by exact_mod_cast (show 0 < q by omega) have hlo := norm_lower_of_reduced_arc hq a hcop (by linarith : 0 < U) harc have hinv : 1 / U < (1 : ℝ) / 2 := one_div_lt_one_div_of_lt (by norm_num) hU by_contra hn have hqY : (q : ℝ) ≤ Y / 2 := le_of_not_gt hn have hstrict : 1 / Y < (1 - 1 / U) / (q : ℝ) := by apply (div_lt_div_iff₀ hY hqR).mpr have hmul := mul_lt_mul_of_pos_right (show (1 : ℝ) / 2 < 1 - 1 / U by linarith) hY nlinarith exact (not_lt_of_ge (hlo.trans halpha)) hstrict theorem norm_le_of_cubePhaseSquare_one {ι : Type*} [Fintype ι] (w : ι → ℕ) (i : ι) (hi : w i = 1) {Y : ℝ} (hY : 0 < Y) {alpha : AddCircle (1 : ℝ)} (hphase : cubePhaseSquare w alpha ≤ (1 / Y) ^ 2) : ‖alpha‖ ≤ 1 / Y := by have ht : ‖alpha‖ ^ 2 ≤ cubePhaseSquare w alpha := by have h := single_le_sum (s := (univ : Finset ι)) (f := fun j ↦ ‖w j • alpha‖ ^ 2) (fun j _ ↦ sq_nonneg _) (mem_univ i) simpa only [hi, one_smul, cubePhaseSquare] using h exact (sq_le_sq₀ (norm_nonneg _) (by positivity)).mp (ht.trans hphase) theorem cubePhaseSquare_reduced_arc_denominator_gt_half {ι : Type*} [Fintype ι] (w : ι → ℕ) (i : ι) (hi : w i = 1) {Y U : ℝ} (hY : 0 < Y) (hU : 2 < U) {q : ℕ} (hq : 2 ≤ q) (a : Fin q) (hcop : Nat.Coprime a.val q) {alpha : AddCircle (1 : ℝ)} (hphase : cubePhaseSquare w alpha ≤ (1 / Y) ^ 2) (harc : dist alpha (circleRationalGridPoint q a) ≤ 1 / ((q : ℝ) * U)) : Y / 2 < (q : ℝ) := reduced_arc_denominator_gt_half hY hU hq a hcop (norm_le_of_cubePhaseSquare_one w i hi hY hphase) harc theorem cubePhaseSquare_far_reduced_approx {ι : Type*} [Fintype ι] (w : ι → ℕ) (i : ι) (hi : w i = 1) {Y : ℝ} (hY : 0 < Y) {U : ℕ} (hU : 2 < U) {alpha : AddCircle (1 : ℝ)} (hphase : cubePhaseSquare w alpha ≤ (1 / Y) ^ 2) (hfar : 1 / (U : ℝ) < ‖alpha‖) : ∃ q : ℕ, 2 ≤ q ∧ q ≤ U ∧ Y / 2 < (q : ℝ) ∧ ∃ a : Fin q, Nat.Coprime a.val q ∧ dist alpha (circleRationalGridPoint q a) ≤ 1 / ((q : ℝ) * (U : ℝ)) := by obtain ⟨q, hq, hqU, a, hcop, harc⟩ := unitCircle_exists_nontrivial_reduced_grid_approx alpha (by omega) hfar exact ⟨q, hq, hqU, cubePhaseSquare_reduced_arc_denominator_gt_half w i hi hY (by exact_mod_cast hU) hq a hcop hphase harc, a, hcop, harc⟩ theorem circle_grid_small_norm_card_le {Y : ℝ} (hY : 0 < Y) {q : ℕ} (hq : 0 < q) (S : Finset (Fin q)) (hS : ∀ a ∈ S, ‖circleRationalGridPoint q a‖ ≤ 1 / Y + 1 / (q : ℝ)) : (S.card : ℝ) ≤ 2 * (q : ℝ) / Y + 3 := by have hqR : (0 : ℝ) < q := by exact_mod_cast hq have hq1 : (1 : ℝ) ≤ q := by exact_mod_cast hq have h := circle_separated_card_in_ball_le S (circleRationalGridPoint q) (by positivity : 0 < 1 / (q : ℝ)) (by simpa only [one_div_one] using one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 1) hq1) (by positivity : 0 ≤ 1 / Y + 1 / (q : ℝ)) (fun a _ b _ hab ↦ circleRationalGridPoint_separated hq a b hab) 0 (fun a ha ↦ by simpa only [dist_zero_right] using hS a ha) have hid : 2 * (1 / Y + 1 / (q : ℝ)) / (1 / (q : ℝ)) + 1 = 2 * (q : ℝ) / Y + 3 := by field_simp ring rwa [hid] at h theorem circle_grid_small_norm_card_le_eight {Y : ℝ} (hY : 0 < Y) {q : ℕ} (hq : 0 < q) (hhalf : Y / 2 < (q : ℝ)) (S : Finset (Fin q)) (hS : ∀ a ∈ S, ‖circleRationalGridPoint q a‖ ≤ 1 / Y + 1 / (q : ℝ)) : (S.card : ℝ) ≤ 8 * (q : ℝ) / Y := by apply (circle_grid_small_norm_card_le hY hq S hS).trans apply (le_div_iff₀ hY).mpr have hid : (2 * (q : ℝ) / Y + 3) * Y = 2 * (q : ℝ) + 3 * Y := by field_simp rw [hid] linarith theorem circleNearGrid_norm_le {F : Set (AddCircle (1 : ℝ))} {Y : ℝ} (hF : ∀ x ∈ F, ‖x‖ ≤ 1 / Y) {q : ℕ} {a : Fin q} (ha : a ∈ circleNearGrid F q) : ‖circleRationalGridPoint q a‖ ≤ 1 / Y + 1 / (q : ℝ) := by obtain ⟨x, hx, hnear⟩ := mem_circleNearGrid.mp ha have ht := dist_triangle (circleRationalGridPoint q a) x 0 rw [dist_zero_right, dist_zero_right] at ht have hn := hF x hx linarith theorem circleNearGrid_card_le_eight {F : Set (AddCircle (1 : ℝ))} {Y : ℝ} (hY : 0 < Y) (hF : ∀ x ∈ F, ‖x‖ ≤ 1 / Y) {q : ℕ} (hq : 0 < q) (hhalf : Y / 2 < (q : ℝ)) : ((circleNearGrid F q).card : ℝ) ≤ 8 * (q : ℝ) / Y := circle_grid_small_norm_card_le_eight hY hq hhalf _ (fun _ ha ↦ circleNearGrid_norm_le hF ha) theorem circleNearGrid_card_le_q (F : Set (AddCircle (1 : ℝ))) (q : ℕ) : ((circleNearGrid F q).card : ℝ) ≤ (q : ℝ) := by have h : (circleNearGrid F q).card ≤ q := by simpa only [card_univ, Fintype.card_fin] using card_le_card (subset_univ (circleNearGrid F q)) exact_mod_cast h /-- A coarse count of all numerators of positive denominators below a real cutoff. -/ theorem sum_positive_denominators_le_square (J : Finset ℕ) {Q0 : ℝ} (hQ0 : 0 ≤ Q0) (hrange : ∀ q ∈ J, 0 < q ∧ (q : ℝ) ≤ Q0) : (∑ q ∈ J, (q : ℝ)) ≤ Q0 ^ 2 := by have hsub : J ⊆ Icc 1 ⌊Q0⌋₊ := by intro q hq exact mem_Icc.mpr ⟨(hrange q hq).1, Nat.le_floor (hrange q hq).2⟩ have hcard : J.card ≤ ⌊Q0⌋₊ := by simpa only [Nat.card_Icc, Nat.add_sub_cancel] using card_le_card hsub have hcardR : (J.card : ℝ) ≤ Q0 := (by exact_mod_cast hcard : (J.card : ℝ) ≤ (⌊Q0⌋₊ : ℝ)).trans (Nat.floor_le hQ0) calc _ ≤ ∑ _q ∈ J, Q0 := sum_le_sum (fun q hq ↦ (hrange q hq).2) _ = (J.card : ℝ) * Q0 := by simp _ ≤ Q0 * Q0 := mul_le_mul_of_nonneg_right hcardR hQ0 _ = Q0 ^ 2 := (pow_two Q0).symm /-- Below the minimum mark scale, the one-dimensional residue count makes the entire rational-arc error at most `Q0^2 * (16G/Y)^m`. -/ theorem independentPrimePhaseArcMass_small_denominators_le {m : ℕ} (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (hw : ∀ i p, p ∈ P i → 0 ≤ weight i p) (F : Set (AddCircle (1 : ℝ))) {Y U G Pmin Q0 : ℝ} (hY : 0 < Y) (hU : 1 ≤ U) (hG : 0 ≤ G) (hPmin : 0 < Pmin) (hQ0 : 0 ≤ Q0) (hQ0P : Q0 ≤ Pmin) (hF : ∀ x ∈ F, ‖x‖ ≤ 1 / Y) (J : Finset ℕ) (hrange : ∀ q ∈ J, 0 < q ∧ Y / 2 < (q : ℝ) ∧ (q : ℝ) ≤ Q0) (hP : ∀ i p, p ∈ P i → (p : ℝ) ≤ U) (hres : ∀ i q, q ∈ J → ∀ r, (∑ p ∈ (P i).filter (fun p ↦ Nat.ModEq q p r), weight i p) ≤ G / (q : ℝ) * (1 + (q : ℝ) / Pmin)) : independentPrimePhaseArcMass P weight F J U ≤ Q0 ^ 2 * (16 * G / Y) ^ m := by let C : ℕ → ℝ := fun q ↦ ((circleNearGrid F q).card : ℝ) let B : ℕ → ℝ := fun q ↦ G / (q : ℝ) * (1 + (q : ℝ) / Pmin) have hC0 (q : ℕ) : 0 ≤ C q := Nat.cast_nonneg _ have hB0 (q : ℕ) : 0 ≤ B q := by dsimp [B]; positivity have hprod (q : ℕ) (hq : q ∈ J) : C q * B q ≤ 16 * G / Y := by have hqR : (0 : ℝ) < q := by exact_mod_cast (hrange q hq).1 have hC : C q ≤ 8 * (q : ℝ) / Y := circleNearGrid_card_le_eight hY hF (hrange q hq).1 (hrange q hq).2.1 have hB : B q ≤ 2 * G / (q : ℝ) := by have hrat : (q : ℝ) / Pmin ≤ 1 := (div_le_one hPmin).mpr ((hrange q hq).2.2.trans hQ0P) calc _ ≤ G / (q : ℝ) * 2 := mul_le_mul_of_nonneg_left (by linarith : 1 + (q : ℝ) / Pmin ≤ 2) (by positivity) _ = _ := by ring calc _ ≤ (8 * (q : ℝ) / Y) * (2 * G / (q : ℝ)) := mul_le_mul hC hB (hB0 q) (by positivity) _ = _ := by field_simp; ring calc _ ≤ ∑ q ∈ J, C q * (C q * B q) ^ m := independentPrimePhaseArcMass_le P weight hw F J hU (fun q hq ↦ (hrange q hq).1) hP C B (fun q _ ↦ hB0 q) (fun _ _ ↦ le_rfl) hres _ ≤ ∑ q ∈ J, (q : ℝ) * (16 * G / Y) ^ m := by apply sum_le_sum intro q hq exact mul_le_mul (circleNearGrid_card_le_q F q) (pow_le_pow_left₀ (mul_nonneg (hC0 q) (hB0 q)) (hprod q hq) m) (pow_nonneg (mul_nonneg (hC0 q) (hB0 q)) m) (Nat.cast_nonneg q) _ = (∑ q ∈ J, (q : ℝ)) * (16 * G / Y) ^ m := (sum_mul _ _ _).symm _ ≤ _ := mul_le_mul_of_nonneg_right (sum_positive_denominators_le_square J hQ0 (fun q hq ↦ ⟨(hrange q hq).1, (hrange q hq).2.2⟩)) (pow_nonneg (by positivity) m) end Erdos859Verification end /- Inlined development module: BernoulliTargetHorizon.lean -/ section /- Deterministic target horizons for the enlarged Bernoulli seed. -/ open Finset Real namespace Erdos859Verification theorem bernoulliSeedScale_log_bounds (k : ℕ) : 3 * (k : ℝ) ^ 3 ≤ log (bernoulliSeedScale k : ℝ) ∧ log (bernoulliSeedScale k : ℝ) ≤ 3 * (k : ℝ) ^ 3 + 1 := by have hlo := log_le_log (exp_pos _) (bernoulliSeedScale_exp_bounds k).1 have hhi := log_le_log (by exact_mod_cast bernoulliSeedScale_pos k) (bernoulliSeedScale_exp_bounds k).2 simpa only [log_exp] using And.intro hlo hhi /-- Explicit endpoint estimates, retaining the useful lower location margin and all ceiling errors in the seed. -/ theorem bernoulli_target_log_bounds {Z r t : ℕ} (hZ : 0 < Z) (hr : 0 < r) {s T0 V a L r0 : ℝ} (hZlo : 3 * s ≤ log (Z : ℝ)) (hZhi : log (Z : ℝ) ≤ 3 * s + 1) (hVlo : T0 ≤ V) (hVhi : V ≤ T0 + 4 * r0 * L + L / 16) (halo : L / 4 ≤ a) (hahi : a ≤ 5 * L / 16) (hrlo : V + a + L / 8 ≤ log (r : ℝ)) (hrhi : log (r : ℝ) ≤ V + a + L / 4) (htlo : (Z : ℝ) * r / 4 ≤ t) (hthi : (t : ℝ) ≤ 3 * Z * r / 4) : T0 + 3 * L / 8 + 3 * s - log 4 ≤ log (t : ℝ) ∧ log (t : ℝ) ≤ T0 + (4 * r0 + 5 / 8) * L + 3 * s + 1 + log (3 / 4) := by have hZR : (0 : ℝ) < Z := by exact_mod_cast hZ have hrR : (0 : ℝ) < r := by exact_mod_cast hr have htR : (0 : ℝ) < t := (div_pos (mul_pos hZR hrR) (by norm_num)).trans_le htlo have hlo := log_le_log (div_pos (mul_pos hZR hrR) (by norm_num)) htlo rw [log_div (mul_pos hZR hrR).ne' (by norm_num), log_mul hZR.ne' hrR.ne'] at hlo have hhi := log_le_log htR hthi have he : (3 : ℝ) * Z * r / 4 = ((Z : ℝ) * r) * (3 / 4) := by ring rw [he, log_mul (mul_pos hZR hrR).ne' (by norm_num), log_mul hZR.ne' hrR.ne'] at hhi constructor <;> nlinarith /-- All represented integers lie in one deterministic interval of logarithmic targets; its upper endpoint is independent of the random shifts. -/ theorem bernoulli_target_log_mem_horizon {Z r t : ℕ} (hZ : 0 < Z) (hr : 0 < r) {s T0 V a L r0 : ℝ} (hs : 1 ≤ s) (hL : 0 ≤ L) (hZlo : 3 * s ≤ log (Z : ℝ)) (hZhi : log (Z : ℝ) ≤ 3 * s + 1) (hVlo : T0 ≤ V) (hVhi : V ≤ T0 + 4 * r0 * L + L / 16) (halo : L / 4 ≤ a) (hahi : a ≤ 5 * L / 16) (hrlo : V + a + L / 8 ≤ log (r : ℝ)) (hrhi : log (r : ℝ) ≤ V + a + L / 4) (htlo : (Z : ℝ) * r / 4 ≤ t) (hthi : (t : ℝ) ≤ 3 * Z * r / 4) : log (t : ℝ) ∈ Set.Icc T0 (T0 + (4 * r0 + 2) * L + 4 * s) := by obtain ⟨hlo, hhi⟩ := bernoulli_target_log_bounds hZ hr hZlo hZhi hVlo hVhi halo hahi hrlo hrhi htlo hthi have hfour : log (4 : ℝ) ≤ 3 := by have h := log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 4) norm_num at h exact h have hthree : log ((3 : ℝ) / 4) ≤ 0 := log_nonpos (by norm_num) (by norm_num) constructor <;> nlinarith theorem bernoulliSeed_target_log_mem_horizon {k r t : ℕ} (hk : 0 < k) (hr : 0 < r) {T0 V a L r0 : ℝ} (hL : 0 ≤ L) (hVlo : T0 ≤ V) (hVhi : V ≤ T0 + 4 * r0 * L + L / 16) (halo : L / 4 ≤ a) (hahi : a ≤ 5 * L / 16) (hrlo : V + a + L / 8 ≤ log (r : ℝ)) (hrhi : log (r : ℝ) ≤ V + a + L / 4) (htlo : (bernoulliSeedScale k : ℝ) * r / 4 ≤ t) (hthi : (t : ℝ) ≤ 3 * bernoulliSeedScale k * r / 4) : log (t : ℝ) ∈ Set.Icc T0 (T0 + (4 * r0 + 2) * L + 4 * (k : ℝ) ^ 3) := by have hkR : (1 : ℝ) ≤ k := by exact_mod_cast hk exact bernoulli_target_log_mem_horizon (bernoulliSeedScale_pos k) hr (one_le_pow₀ hkR) hL (bernoulliSeedScale_log_bounds k).1 (bernoulliSeedScale_log_bounds k).2 hVlo hVhi halo hahi hrlo hrhi htlo hthi /-- A concrete natural interval contained in `[N/4,3N/4]`. -/ theorem quarter_interval_mem_bounds {N t : ℕ} (ht : t ∈ Icc (N / 4 + 1) (3 * N / 4)) : (N : ℝ) / 4 ≤ t ∧ (t : ℝ) ≤ 3 * N / 4 := by obtain ⟨hlo, hhi⟩ := mem_Icc.mp ht have hlo' : N ≤ 4 * t := by omega have hhi' : 4 * t ≤ 3 * N := by omega have hloR : (N : ℝ) ≤ 4 * t := by exact_mod_cast hlo' have hhiR : 4 * (t : ℝ) ≤ 3 * N := by exact_mod_cast hhi' constructor · linarith · linarith /-- Every such integer interval carries a fixed positive harmonic mass. This weaker absolute constant suffices for the mesh coverage argument. -/ theorem quarter_interval_harmonic_mass {N : ℕ} (hN : 4 ≤ N) : (1 : ℝ) / 4 ≤ ∑ t ∈ Icc (N / 4 + 1) (3 * N / 4), 1 / (t : ℝ) := by have hNpos : (0 : ℝ) < N := by exact_mod_cast (show 0 < N by omega) have hcard : N ≤ 4 * (Icc (N / 4 + 1) (3 * N / 4)).card := by rw [Nat.card_Icc] omega have hcardR : (N : ℝ) ≤ 4 * ((Icc (N / 4 + 1) (3 * N / 4)).card : ℝ) := by exact_mod_cast hcard calc _ ≤ ((Icc (N / 4 + 1) (3 * N / 4)).card : ℝ) / N := by apply (le_div_iff₀ hNpos).mpr linarith _ = ∑ _t ∈ Icc (N / 4 + 1) (3 * N / 4), 1 / (N : ℝ) := by simp [div_eq_mul_inv] _ ≤ _ := by apply sum_le_sum intro t ht obtain ⟨hlo, hhi⟩ := mem_Icc.mp ht have htpos : (0 : ℝ) < t := by exact_mod_cast (show 0 < t by omega) have htN : (t : ℝ) ≤ N := by exact_mod_cast (show t ≤ N by omega) exact one_div_le_one_div_of_le htpos htN /-- The concrete natural interval has fixed harmonic mass and every one of its targets belongs to the deterministic logarithmic horizon. -/ theorem bernoulliSeed_target_interval_harmonic {k r : ℕ} (hk : 0 < k) (hr : 0 < r) {T0 V a L r0 : ℝ} (hL : 0 ≤ L) (hVlo : T0 ≤ V) (hVhi : V ≤ T0 + 4 * r0 * L + L / 16) (halo : L / 4 ≤ a) (hahi : a ≤ 5 * L / 16) (hrlo : V + a + L / 8 ≤ log (r : ℝ)) (hrhi : log (r : ℝ) ≤ V + a + L / 4) (hsize : 4 ≤ bernoulliSeedScale k * r) : (1 : ℝ) / 4 ≤ (∑ t ∈ Icc (bernoulliSeedScale k * r / 4 + 1) (3 * (bernoulliSeedScale k * r) / 4), 1 / (t : ℝ)) ∧ ∀ t ∈ Icc (bernoulliSeedScale k * r / 4 + 1) (3 * (bernoulliSeedScale k * r) / 4), log (t : ℝ) ∈ Set.Icc T0 (T0 + (4 * r0 + 2) * L + 4 * (k : ℝ) ^ 3) := by refine ⟨quarter_interval_harmonic_mass hsize, ?_⟩ intro t ht obtain ⟨htlo, hthi⟩ := quarter_interval_mem_bounds ht apply bernoulliSeed_target_log_mem_horizon hk hr hL hVlo hVhi halo hahi hrlo hrhi · simpa only [Nat.cast_mul] using htlo · simpa only [Nat.cast_mul, Nat.cast_ofNat, mul_assoc] using hthi end Erdos859Verification end /- Inlined development module: FiniteQuantileCoupling.lean -/ section /- Exact finite inverse-CDF intervals and common-uniform quantile transport. -/ namespace Erdos859Verification open Finset Real MeasureTheory noncomputable def finiteMarkCDF (P : Finset ℝ) (a : ℝ → ℝ) (v : ℝ) : ℝ := ∑ x ∈ P.filter (fun x ↦ x ≤ v), a x noncomputable def finiteMarkLeftCDF (P : Finset ℝ) (a : ℝ → ℝ) (v : ℝ) : ℝ := ∑ x ∈ P.filter (fun x ↦ x < v), a x noncomputable def finiteQuantileCell (P : Finset ℝ) (a : ℝ → ℝ) (x : ℝ) : Set ℝ := Set.Ioc (finiteMarkLeftCDF P a x) (finiteMarkCDF P a x) theorem finiteMarkCDF_sub_left {P : Finset ℝ} (a : ℝ → ℝ) {x : ℝ} (hx : x ∈ P) : finiteMarkCDF P a x - finiteMarkLeftCDF P a x = a x := by classical have hi : P.filter (fun y ↦ y ≤ x) = insert x (P.filter (fun y ↦ y < x)) := by ext y simp only [Finset.mem_filter, Finset.mem_insert] constructor · intro h rcases h.2.eq_or_lt with he | hl · exact Or.inl he · exact Or.inr ⟨h.1, hl⟩ · rintro (rfl | ⟨hy, hyx⟩) · exact ⟨hx, le_rfl⟩ · exact ⟨hy, hyx.le⟩ unfold finiteMarkCDF finiteMarkLeftCDF rw [hi, sum_insert (by simp)] ring theorem finiteMarkCDF_le_left {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) {v x : ℝ} (hvx : v < x) : finiteMarkCDF P a v ≤ finiteMarkLeftCDF P a x := by classical apply sum_le_sum_of_subset_of_nonneg · intro y hy exact Finset.mem_filter.mpr ⟨(Finset.mem_filter.mp hy).1, ((Finset.mem_filter.mp hy).2).trans_lt hvx⟩ · intro y hy _ exact ha y (Finset.mem_filter.mp hy).1 theorem finiteQuantileCell_subset {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) (x : ℝ) : finiteQuantileCell P a x ⊆ Set.Ioc 0 1 := by intro s hs have hl : 0 ≤ finiteMarkLeftCDF P a x := sum_nonneg (fun y hy ↦ ha y (Finset.mem_filter.mp hy).1) have hu : finiteMarkCDF P a x ≤ 1 := by rw [← hnorm] exact sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun y hy _ ↦ ha y hy) exact ⟨hl.trans_lt hs.1, hs.2.trans hu⟩ theorem finiteQuantileCells_disjoint {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) : (P : Set ℝ).PairwiseDisjoint (finiteQuantileCell P a) := by intro x _ y _ hxy change Disjoint (finiteQuantileCell P a x) (finiteQuantileCell P a y) rw [Set.disjoint_left] intro s hsx hsy rcases lt_or_gt_of_ne hxy with h | h · have hc := finiteMarkCDF_le_left ha h exact (not_lt_of_ge (hsx.2.trans hc)) hsy.1 · have hc := finiteMarkCDF_le_left ha h exact (not_lt_of_ge (hsy.2.trans hc)) hsx.1 theorem exists_finiteQuantileCell {P : Finset ℝ} {a : ℝ → ℝ} (hnorm : ∑ x ∈ P, a x = 1) {s : ℝ} (hs : s ∈ Set.Ioc (0 : ℝ) 1) : ∃ x ∈ P, s ∈ finiteQuantileCell P a x := by classical have hP : P.Nonempty := by by_contra h have hzero : P = ∅ := not_nonempty_iff_eq_empty.mp h simp only [hzero, sum_empty] at hnorm norm_num at hnorm let S := P.filter (fun x ↦ s ≤ finiteMarkCDF P a x) have hmax : finiteMarkCDF P a (P.max' hP) = 1 := by unfold finiteMarkCDF rw [filter_eq_self.mpr (fun y hy ↦ le_max' P y hy)] exact hnorm have hS : S.Nonempty := by refine ⟨P.max' hP, Finset.mem_filter.mpr ⟨max'_mem P hP, ?_⟩⟩ simpa only [hmax] using hs.2 let x := S.min' hS have hxS : x ∈ S := min'_mem S hS have hxP : x ∈ P := (Finset.mem_filter.mp hxS).1 have hsu : s ≤ finiteMarkCDF P a x := (Finset.mem_filter.mp hxS).2 refine ⟨x, hxP, ?_, hsu⟩ by_contra hn have hsl : s ≤ finiteMarkLeftCDF P a x := le_of_not_gt hn let Q := P.filter (fun y ↦ y < x) have hQ : Q.Nonempty := by by_contra h have hzero : Q = ∅ := not_nonempty_iff_eq_empty.mp h have hz : finiteMarkLeftCDF P a x = 0 := by change (∑ y ∈ Q, a y) = 0 rw [hzero, sum_empty] linarith [hs.1] let y := Q.max' hQ have hyQ : y ∈ Q := max'_mem Q hQ have hyP : y ∈ P := (Finset.mem_filter.mp hyQ).1 have hyx : y < x := (Finset.mem_filter.mp hyQ).2 have hfilter : P.filter (fun z ↦ z ≤ y) = Q := by ext z simp only [Finset.mem_filter] constructor · exact fun ⟨hz, hzy⟩ ↦ Finset.mem_filter.mpr ⟨hz, hzy.trans_lt hyx⟩ · intro hz have hzQ : z ∈ Q := hz exact ⟨(Finset.mem_filter.mp hzQ).1, le_max' Q z hzQ⟩ have hcy : finiteMarkCDF P a y = finiteMarkLeftCDF P a x := by unfold finiteMarkCDF rw [hfilter] rfl have hyS : y ∈ S := Finset.mem_filter.mpr ⟨hyP, hcy ▸ hsl⟩ have hxy : x ≤ y := min'_le S y hyS exact (not_lt_of_ge hxy) hyx theorem finiteQuantileCells_cover {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) : (⋃ x ∈ P, finiteQuantileCell P a x) = Set.Ioc 0 1 := by ext s simp only [Set.mem_iUnion] constructor · rintro ⟨x, _, hs⟩ exact finiteQuantileCell_subset ha hnorm x hs · intro hs obtain ⟨x, hx, hsx⟩ := exists_finiteQuantileCell hnorm hs exact ⟨x, hx, hsx⟩ theorem volume_finiteQuantileCell {P : Finset ℝ} (a : ℝ → ℝ) {x : ℝ} (hx : x ∈ P) : volume (finiteQuantileCell P a x) = ENNReal.ofReal (a x) := by rw [finiteQuantileCell, Real.volume_Ioc, finiteMarkCDF_sub_left a hx] noncomputable def finiteQuantile (P : Finset ℝ) (a : ℝ → ℝ) (s : ℝ) : ℝ := ∑ x ∈ P, (finiteQuantileCell P a x).indicator (fun _ ↦ x) s theorem measurable_finiteQuantile (P : Finset ℝ) (a : ℝ → ℝ) : Measurable (finiteQuantile P a) := by classical apply Finset.measurable_sum intro x _ exact measurable_const.indicator measurableSet_Ioc theorem finiteQuantile_eq_of_mem {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) {x s : ℝ} (hx : x ∈ P) (hs : s ∈ finiteQuantileCell P a x) : finiteQuantile P a s = x := by classical unfold finiteQuantile rw [sum_eq_single x] · exact Set.indicator_of_mem hs _ · intro y hy hyx apply Set.indicator_of_notMem intro hsy have hd := finiteQuantileCells_disjoint ha hy hx hyx exact Set.disjoint_left.mp hd hsy hs · exact fun h ↦ False.elim (h hx) theorem finiteQuantile_mem_cell {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) {s : ℝ} (hs : s ∈ Set.Ioc (0 : ℝ) 1) : finiteQuantile P a s ∈ P ∧ s ∈ finiteQuantileCell P a (finiteQuantile P a s) := by obtain ⟨x, hx, hsx⟩ := exists_finiteQuantileCell hnorm hs rw [finiteQuantile_eq_of_mem ha hx hsx] exact ⟨hx, hsx⟩ /-- A lower increment bound for the comparison CDF turns uniform CDF error into deterministic transport error. No assumption concerning a selected Bernoulli cardinality or a Poisson law is used. -/ theorem finiteQuantile_displacement {P : Finset ℝ} {a H : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) {u z K e s v : ℝ} (hK : 0 < K) (he : 0 ≤ e) (hP : ∀ x ∈ P, x ∈ Set.Icc u z) (hinc : ∀ x ∈ Set.Icc u z, ∀ y ∈ Set.Icc u z, x ≤ y → (y - x) / K ≤ H y - H x) (hcdf : ∀ y ∈ Set.Icc u z, |finiteMarkCDF P a y - H y| ≤ e) (hs : s ∈ Set.Ioc (0 : ℝ) 1) (hv : v ∈ Set.Icc u z) (hHv : H v = s) : |finiteQuantile P a s - v| ≤ K * e := by obtain ⟨hxP, hsx⟩ := finiteQuantile_mem_cell ha hnorm hs let x := finiteQuantile P a s have hx : x ∈ Set.Icc u z := hP x hxP have hFx := hcdf x hx have hleft : finiteMarkLeftCDF P a x < s := hsx.1 have hright : s ≤ finiteMarkCDF P a x := hsx.2 apply abs_le.mpr constructor · by_cases hxv : x ≤ v · have hi := hinc x hx v hv hxv rw [hHv] at hi have hi' := (div_le_iff₀ hK).mp hi have hh := (abs_le.mp hFx).2 nlinarith · have hxv' : v < x := lt_of_not_ge hxv change -(K * e) ≤ x - v nlinarith [mul_nonneg hK.le he] · by_contra hn have hlarge : K * e < x - v := lt_of_not_ge hn let y := (x + v + K * e) / 2 have hvy : v ≤ y := by dsimp [y]; nlinarith [mul_nonneg hK.le he] have hyx : y < x := by dsimp [y]; linarith have hy : y ∈ Set.Icc u z := ⟨hv.1.trans hvy, hyx.le.trans hx.2⟩ have hFy : finiteMarkCDF P a y < s := (finiteMarkCDF_le_left ha hyx).trans_lt hleft have hi := (div_le_iff₀ hK).mp (hinc v hv y hy hvy) rw [hHv] at hi have hh := (abs_le.mp (hcdf y hy)).1 dsimp [y] at hi nlinarith theorem finiteQuantile_preimage_inter {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) (B : Set ℝ) [DecidablePred (fun x ↦ x ∈ B)] : (finiteQuantile P a ⁻¹' B) ∩ Set.Ioc 0 1 = ⋃ x ∈ P.filter (fun x ↦ x ∈ B), finiteQuantileCell P a x := by classical ext s simp only [Set.mem_inter_iff, Set.mem_preimage, Set.mem_iUnion] constructor · rintro ⟨hsB, hs⟩ obtain ⟨hx, hsx⟩ := finiteQuantile_mem_cell ha hnorm hs exact ⟨finiteQuantile P a s, Finset.mem_filter.mpr ⟨hx, hsB⟩, hsx⟩ · rintro ⟨x, hx, hsx⟩ have hxP := (Finset.mem_filter.mp hx).1 have heq := finiteQuantile_eq_of_mem ha hxP hsx refine ⟨?_, finiteQuantileCell_subset ha hnorm x hsx⟩ rw [heq] exact (Finset.mem_filter.mp hx).2 theorem volume_finiteQuantile_preimage_inter {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) (B : Set ℝ) [DecidablePred (fun x ↦ x ∈ B)] : volume ((finiteQuantile P a ⁻¹' B) ∩ Set.Ioc 0 1) = ∑ x ∈ P.filter (fun x ↦ x ∈ B), ENNReal.ofReal (a x) := by classical rw [finiteQuantile_preimage_inter ha hnorm] have hd : ((P.filter (fun x ↦ x ∈ B)) : Set ℝ).PairwiseDisjoint (finiteQuantileCell P a) := by intro x hx y hy hxy exact finiteQuantileCells_disjoint ha (Finset.mem_filter.mp hx).1 (Finset.mem_filter.mp hy).1 hxy rw [measure_biUnion_finset hd (fun _ _ ↦ measurableSet_Ioc)] apply sum_congr rfl intro x hx exact volume_finiteQuantileCell a (Finset.mem_filter.mp hx).1 noncomputable def finiteMarkLaw (P : Finset ℝ) (a : ℝ → ℝ) : Measure ℝ := ∑ x ∈ P, ENNReal.ofReal (a x) • Measure.dirac x /-- The finite quantile is an exact realization of the specified mark law from one uniform coordinate. -/ theorem finiteQuantile_map_uniform {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) : Measure.map (finiteQuantile P a) (volume.restrict (Set.Ioc (0 : ℝ) 1)) = finiteMarkLaw P a := by classical ext B hB rw [Measure.map_apply (measurable_finiteQuantile P a) hB, Measure.restrict_apply ((measurable_finiteQuantile P a) hB), volume_finiteQuantile_preimage_inter ha hnorm] simp only [finiteMarkLaw, Measure.coe_finsetSum, Finset.sum_apply, Measure.smul_apply, smul_eq_mul] rw [sum_filter] apply sum_congr rfl intro x _ by_cases hx : x ∈ B · simp [hx] · simp [hx] theorem finiteQuantile_uniform_isProbability : IsProbabilityMeasure (volume.restrict (Set.Ioc (0 : ℝ) 1)) := by constructor simp only [Measure.restrict_apply_univ, Real.volume_Ioc] norm_num theorem finiteMarkLaw_isProbability {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) : IsProbabilityMeasure (finiteMarkLaw P a) := by let : IsProbabilityMeasure (volume.restrict (Set.Ioc (0 : ℝ) 1)) := finiteQuantile_uniform_isProbability rw [← finiteQuantile_map_uniform ha hnorm] exact Measure.isProbabilityMeasure_map (measurable_finiteQuantile P a).aemeasurable noncomputable def logUniformQuantile (u w s : ℝ) : ℝ := u * exp (s * log (1 + w / u)) theorem measurable_logUniformQuantile (u w : ℝ) : Measurable (logUniformQuantile u w) := by unfold logUniformQuantile fun_prop theorem logUniformQuantile_mem {u w s : ℝ} (hw : 0 < w) (hwu : w ≤ u) (hs : s ∈ Set.Icc (0 : ℝ) 1) : logUniformQuantile u w s ∈ Set.Icc u (u + w) := by have hu : 0 < u := hw.trans_le hwu have hH := (logUniform_log_bounds hw hwu).1 have harg : 0 < 1 + w / u := by positivity have hlo : 1 ≤ exp (s * log (1 + w / u)) := one_le_exp (mul_nonneg hs.1 hH.le) have hhi : exp (s * log (1 + w / u)) ≤ 1 + w / u := by calc _ ≤ exp (log (1 + w / u)) := exp_le_exp.mpr (by nlinarith [hs.2]) _ = _ := exp_log harg unfold logUniformQuantile constructor · nlinarith · have hm := mul_le_mul_of_nonneg_left hhi hu.le have hid : u * (1 + w / u) = u + w := by field_simp linarith theorem logUniformQuantile_inverse {u w s : ℝ} (hw : 0 < w) (hwu : w ≤ u) : log (logUniformQuantile u w s / u) / log (1 + w / u) = s := by have hu : 0 < u := hw.trans_le hwu have hH := (logUniform_log_bounds hw hwu).1 have hid : logUniformQuantile u w s / u = exp (s * log (1 + w / u)) := by unfold logUniformQuantile field_simp rw [hid, log_exp] exact mul_div_cancel_right₀ s hH.ne' theorem logUniformCDF_increment {u w x y : ℝ} (hw : 0 < w) (hwu : w ≤ u) (hx : x ∈ Set.Icc u (u + w)) (hy : y ∈ Set.Icc u (u + w)) (hxy : x ≤ y) : (y - x) / (2 * w) ≤ log (y / u) / log (1 + w / u) - log (x / u) / log (1 + w / u) := by have hu : 0 < u := hw.trans_le hwu have hx0 : 0 < x := hu.trans_le hx.1 have hy0 : 0 < y := hu.trans_le hy.1 obtain ⟨hH, _, hHhi⟩ := logUniform_log_bounds hw hwu have hden : y * log (1 + w / u) ≤ 2 * w := by have hh := (le_div_iff₀ hu).mp hHhi have hym : y * log (1 + w / u) ≤ 2 * u * log (1 + w / u) := mul_le_mul_of_nonneg_right (by linarith [hy.2]) hH.le nlinarith have hlog : (y - x) / y ≤ log (y / x) := by have h := one_sub_inv_le_log_of_pos (div_pos hy0 hx0) have hid : 1 - (y / x)⁻¹ = (y - x) / y := by field_simp rwa [hid] at h calc _ ≤ (y - x) / (y * log (1 + w / u)) := div_le_div_of_nonneg_left (sub_nonneg.mpr hxy) (mul_pos hy0 hH) hden _ = ((y - x) / y) / log (1 + w / u) := by ring _ ≤ log (y / x) / log (1 + w / u) := div_le_div_of_nonneg_right hlog hH.le _ = _ := by rw [log_div hy0.ne' hx0.ne', log_div hy0.ne' hu.ne', log_div hx0.ne' hu.ne'] ring /-- The log-uniform comparison specializes the deterministic error to twice the window width times the CDF discrepancy. -/ theorem finiteQuantile_logUniform_displacement {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) {u w e s : ℝ} (hw : 0 < w) (hwu : w ≤ u) (he : 0 ≤ e) (hP : ∀ x ∈ P, x ∈ Set.Icc u (u + w)) (hcdf : ∀ v ∈ Set.Icc u (u + w), |finiteMarkCDF P a v - log (v / u) / log (1 + w / u)| ≤ e) (hs : s ∈ Set.Ioc (0 : ℝ) 1) : |finiteQuantile P a s - logUniformQuantile u w s| ≤ 2 * w * e := by exact finiteQuantile_displacement ha hnorm (by positivity) he hP (fun _ hx _ hy hxy ↦ logUniformCDF_increment hw hwu hx hy hxy) hcdf hs (logUniformQuantile_mem hw hwu ⟨hs.1.le, hs.2⟩) (logUniformQuantile_inverse hw hwu) theorem finiteQuantile_logUniform_mertens_displacement {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) {u w s : ℝ} (hw : 0 < w) (hwu : w ≤ u) (hP : ∀ x ∈ P, x ∈ Set.Icc u (u + w)) (hcdf : ∀ v ∈ Set.Icc u (u + w), |finiteMarkCDF P a v - log (v / u) / log (1 + w / u)| ≤ 8 * primeLogOddsErrorConstant / w) (hs : s ∈ Set.Ioc (0 : ℝ) 1) : |finiteQuantile P a s - logUniformQuantile u w s| ≤ 16 * primeLogOddsErrorConstant := by have hC := primeLogOddsErrorConstant_pos have h := finiteQuantile_logUniform_displacement ha hnorm hw hwu (by positivity) hP hcdf hs convert h using 1 field_simp ring noncomputable def finiteQuantileCoupling (P : Finset ℝ) (a Q : ℝ → ℝ) : Measure (ℝ × ℝ) := Measure.map (fun s ↦ (finiteQuantile P a s, Q s)) (volume.restrict (Set.Ioc (0 : ℝ) 1)) theorem finiteQuantileCoupling_fst {P : Finset ℝ} {a Q : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) (hQ : Measurable Q) : Measure.map Prod.fst (finiteQuantileCoupling P a Q) = finiteMarkLaw P a := by unfold finiteQuantileCoupling rw [Measure.map_map measurable_fst ((measurable_finiteQuantile P a).prodMk hQ)] exact finiteQuantile_map_uniform ha hnorm theorem finiteQuantileCoupling_snd (P : Finset ℝ) (a : ℝ → ℝ) {Q : ℝ → ℝ} (hQ : Measurable Q) : Measure.map Prod.snd (finiteQuantileCoupling P a Q) = Measure.map Q (volume.restrict (Set.Ioc (0 : ℝ) 1)) := by unfold finiteQuantileCoupling rw [Measure.map_map measurable_snd ((measurable_finiteQuantile P a).prodMk hQ)] rfl theorem finiteQuantileCoupling_displacement_measure_one (P : Finset ℝ) (a : ℝ → ℝ) {Q : ℝ → ℝ} (hQ : Measurable Q) {r : ℝ} (hbound : ∀ s ∈ Set.Ioc (0 : ℝ) 1, |finiteQuantile P a s - Q s| ≤ r) : finiteQuantileCoupling P a Q {z | |z.1 - z.2| ≤ r} = 1 := by have hm : MeasurableSet {z : ℝ × ℝ | |z.1 - z.2| ≤ r} := by measurability have hpair := (measurable_finiteQuantile P a).prodMk hQ unfold finiteQuantileCoupling rw [Measure.map_apply hpair hm, Measure.restrict_apply (hpair hm)] have hi : ((fun s ↦ (finiteQuantile P a s, Q s)) ⁻¹' {z | |z.1 - z.2| ≤ r}) ∩ Set.Ioc (0 : ℝ) 1 = Set.Ioc 0 1 := by ext s simp only [Set.mem_inter_iff, Set.mem_preimage, Set.mem_ofPred_eq] exact and_iff_right_of_imp (hbound s) rw [hi, Real.volume_Ioc] norm_num theorem finiteQuantile_logUniform_coupling_displacement {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) {u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) (hP : ∀ x ∈ P, x ∈ Set.Icc u (u + w)) (hcdf : ∀ v ∈ Set.Icc u (u + w), |finiteMarkCDF P a v - log (v / u) / log (1 + w / u)| ≤ 8 * primeLogOddsErrorConstant / w) : finiteQuantileCoupling P a (logUniformQuantile u w) {z | |z.1 - z.2| ≤ 16 * primeLogOddsErrorConstant} = 1 := by exact finiteQuantileCoupling_displacement_measure_one P a (measurable_logUniformQuantile u w) (fun _ hs ↦ finiteQuantile_logUniform_mertens_displacement ha hnorm hw hwu hP hcdf hs) end Erdos859Verification end /- Inlined development module: LogUniformQuantileLaw.lean -/ section /- The explicit log-uniform inverse has the exact previously constructed density law, completing the continuous marginal of the quantile coupling. -/ namespace Erdos859Verification open Real MeasureTheory theorem logUniformLaw_apply_eq_integral {u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) {B : Set ℝ} (hB : MeasurableSet B) : translationShiftLaw (logUniformDensity u w) B = ENNReal.ofReal (∫ x in B, logUniformDensity u w x) := by rw [translationShiftLaw, withDensity_apply _ hB] symm exact ofReal_integral_eq_lintegral_ofReal (integrable_logUniformDensity hw hwu).integrableOn (Filter.Eventually.of_forall (logUniformDensity_nonneg hw hwu)) theorem logUniformLaw_Iic_of_mem {u w v : ℝ} (hw : 0 < w) (hwu : w ≤ u) (hv : v ∈ Set.Icc u (u + w)) : translationShiftLaw (logUniformDensity u w) (Set.Iic v) = ENNReal.ofReal (log (v / u) / log (1 + w / u)) := by have hu : 0 < u := hw.trans_le hwu have hv0 : 0 < v := hu.trans_le hv.1 rw [logUniformLaw_apply_eq_integral hw hwu measurableSet_Iic] congr 1 unfold logUniformDensity rw [setIntegral_indicator measurableSet_Icc] have hi : Set.Iic v ∩ Set.Icc u (u + w) = Set.Icc u v := by ext x simp only [Set.mem_inter_iff, Set.mem_Iic, Set.mem_Icc] constructor · exact fun ⟨hxv, hux, _⟩ ↦ ⟨hux, hxv⟩ · exact fun ⟨hux, hxv⟩ ↦ ⟨hxv, hux, hxv.trans hv.2⟩ rw [hi] have hfun : (fun x : ℝ ↦ 1 / (x * log (1 + w / u))) = fun x ↦ (1 / log (1 + w / u)) * (1 / x) := by funext x; ring rw [hfun, integral_const_mul, integral_Icc_eq_integral_Ioc, ← intervalIntegral.integral_of_le hv.1, integral_one_div_of_pos hu hv0] ring theorem logUniformLaw_Iic_below {u w v : ℝ} (hw : 0 < w) (hwu : w ≤ u) (hv : v < u) : translationShiftLaw (logUniformDensity u w) (Set.Iic v) = 0 := by rw [logUniformLaw_apply_eq_integral hw hwu measurableSet_Iic] have hi : (∫ x in Set.Iic v, logUniformDensity u w x) = 0 := by apply setIntegral_eq_zero_of_forall_eq_zero intro x hx apply logUniformDensity_eq_zero intro hxu exact (not_lt_of_ge hxu.1) (hx.trans_lt hv) rw [hi, ENNReal.ofReal_zero] theorem logUniformLaw_Iic_above {u w v : ℝ} (hw : 0 < w) (hwu : w ≤ u) (hv : u + w ≤ v) : translationShiftLaw (logUniformDensity u w) (Set.Iic v) = 1 := by rw [logUniformLaw_apply_eq_integral hw hwu measurableSet_Iic] have hi : (∫ x in Set.Iic v, logUniformDensity u w x) = ∫ x, logUniformDensity u w x := by apply setIntegral_eq_integral_of_forall_compl_eq_zero intro x hx apply logUniformDensity_eq_zero intro hxu exact hx (hxu.2.trans hv) rw [hi, integral_logUniformDensity hw hwu, ENNReal.ofReal_one] theorem logUniformQuantile_le_iff {u w v s : ℝ} (hw : 0 < w) (hwu : w ≤ u) (hv : 0 < v) : logUniformQuantile u w s ≤ v ↔ s ≤ log (v / u) / log (1 + w / u) := by have hu : 0 < u := hw.trans_le hwu have hH := (logUniform_log_bounds hw hwu).1 unfold logUniformQuantile rw [← le_div_iff₀' hu, ← le_log_iff_exp_le (div_pos hv hu), ← le_div_iff₀ hH] theorem logUniformQuantile_map_Iic_of_mem {u w v : ℝ} (hw : 0 < w) (hwu : w ≤ u) (hv : v ∈ Set.Icc u (u + w)) : Measure.map (logUniformQuantile u w) (volume.restrict (Set.Ioc (0 : ℝ) 1)) (Set.Iic v) = ENNReal.ofReal (log (v / u) / log (1 + w / u)) := by have hu : 0 < u := hw.trans_le hwu have hv0 : 0 < v := hu.trans_le hv.1 have hH := (logUniform_log_bounds hw hwu).1 have hG : log (v / u) / log (1 + w / u) ≤ 1 := by apply (div_le_one hH).mpr apply log_le_log (div_pos hv0 hu) have hid : 1 + w / u = (u + w) / u := by field_simp rw [hid] exact div_le_div_of_nonneg_right hv.2 hu.le rw [Measure.map_apply (measurable_logUniformQuantile u w) measurableSet_Iic, Measure.restrict_apply ((measurable_logUniformQuantile u w) measurableSet_Iic)] have hi : (logUniformQuantile u w ⁻¹' Set.Iic v) ∩ Set.Ioc (0 : ℝ) 1 = Set.Ioc 0 (log (v / u) / log (1 + w / u)) := by ext s simp only [Set.mem_inter_iff, Set.mem_preimage, Set.mem_Iic, Set.mem_Ioc, logUniformQuantile_le_iff hw hwu hv0] constructor · exact fun ⟨hsg, hs0, _⟩ ↦ ⟨hs0, hsg⟩ · exact fun ⟨hs0, hsg⟩ ↦ ⟨hsg, hs0, hsg.trans hG⟩ rw [hi, Real.volume_Ioc, sub_zero] theorem logUniformQuantile_map_Iic_below {u w v : ℝ} (hw : 0 < w) (hwu : w ≤ u) (hv : v < u) : Measure.map (logUniformQuantile u w) (volume.restrict (Set.Ioc (0 : ℝ) 1)) (Set.Iic v) = 0 := by rw [Measure.map_apply (measurable_logUniformQuantile u w) measurableSet_Iic, Measure.restrict_apply ((measurable_logUniformQuantile u w) measurableSet_Iic)] have hi : (logUniformQuantile u w ⁻¹' Set.Iic v) ∩ Set.Ioc (0 : ℝ) 1 = ∅ := by apply Set.eq_empty_iff_forall_notMem.mpr intro s hs have hq := logUniformQuantile_mem hw hwu ⟨hs.2.1.le, hs.2.2⟩ exact (not_lt_of_ge hq.1) (hs.1.trans_lt hv) rw [hi, measure_empty] theorem logUniformQuantile_map_Iic_above {u w v : ℝ} (hw : 0 < w) (hwu : w ≤ u) (hv : u + w ≤ v) : Measure.map (logUniformQuantile u w) (volume.restrict (Set.Ioc (0 : ℝ) 1)) (Set.Iic v) = 1 := by rw [Measure.map_apply (measurable_logUniformQuantile u w) measurableSet_Iic, Measure.restrict_apply ((measurable_logUniformQuantile u w) measurableSet_Iic)] have hi : (logUniformQuantile u w ⁻¹' Set.Iic v) ∩ Set.Ioc (0 : ℝ) 1 = Set.Ioc 0 1 := by apply Set.inter_eq_right.mpr intro s hs exact (logUniformQuantile_mem hw hwu ⟨hs.1.le, hs.2⟩).2.trans hv rw [hi, Real.volume_Ioc] norm_num /-- The explicit inverse-CDF construction has exactly the logarithmic density. -/ theorem logUniformQuantile_map_eq {u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) : Measure.map (logUniformQuantile u w) (volume.restrict (Set.Ioc (0 : ℝ) 1)) = translationShiftLaw (logUniformDensity u w) := by let : IsProbabilityMeasure (volume.restrict (Set.Ioc (0 : ℝ) 1)) := finiteQuantile_uniform_isProbability let : IsProbabilityMeasure (Measure.map (logUniformQuantile u w) (volume.restrict (Set.Ioc (0 : ℝ) 1))) := Measure.isProbabilityMeasure_map (measurable_logUniformQuantile u w).aemeasurable apply Measure.ext_of_Iic intro v by_cases hlo : v < u · rw [logUniformQuantile_map_Iic_below hw hwu hlo, logUniformLaw_Iic_below hw hwu hlo] · by_cases hhi : u + w ≤ v · rw [logUniformQuantile_map_Iic_above hw hwu hhi, logUniformLaw_Iic_above hw hwu hhi] · have hv : v ∈ Set.Icc u (u + w) := ⟨le_of_not_gt hlo, (lt_of_not_ge hhi).le⟩ rw [logUniformQuantile_map_Iic_of_mem hw hwu hv, logUniformLaw_Iic_of_mem hw hwu hv] theorem finiteQuantile_logUniform_coupling_marginals {P : Finset ℝ} {a : ℝ → ℝ} (ha : ∀ x ∈ P, 0 ≤ a x) (hnorm : ∑ x ∈ P, a x = 1) {u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) : Measure.map Prod.fst (finiteQuantileCoupling P a (logUniformQuantile u w)) = finiteMarkLaw P a ∧ Measure.map Prod.snd (finiteQuantileCoupling P a (logUniformQuantile u w)) = translationShiftLaw (logUniformDensity u w) := by constructor · exact finiteQuantileCoupling_fst ha hnorm (measurable_logUniformQuantile u w) · rw [finiteQuantileCoupling_snd P a (measurable_logUniformQuantile u w), logUniformQuantile_map_eq hw hwu] end Erdos859Verification end /- Inlined development module: PrimeUnnormalizedCount.lean -/ section /- Unnormalized finite-mark form of the tilted fixed-count lower bound. -/ namespace Erdos859Verification open Finset Real theorem primeTilt_count_lower_from_unnormalized_marks {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (n : ℕ) (w : ℕ → ℝ) (F : Finset ℕ → ℝ) (hw : ∀ p ∈ P, 0 ≤ w p) (hodds : ∀ p ∈ P, w p ≤ lam / ((p : ℝ) - 1)) (hF : ∀ T ∈ P.powerset.filter (fun T ↦ T.card = n), 0 ≤ F T) : exp (-(∑ p ∈ P, primeLogOddsIntensity lam p)) / (n.factorial : ℝ) * (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, w (x i).val) * F (tupleSupport x)) ≤ ∑ T ∈ P.powerset.filter (fun T ↦ T.card = n), primeTiltWeight P lam T * F T := by rw [sum_injective_tuple_product, ← mul_assoc, div_mul_cancel₀ _ (by exact_mod_cast Nat.factorial_ne_zero n), mul_sum] apply sum_le_sum intro T hT have hTP := mem_powerset.mp (mem_filter.mp hT).1 rw [primeTiltWeight_eq_empty_mul_tilted_odds hP hTP, primeTiltWeight_empty_eq_exp_neg_intensity hP hlam, ← mul_assoc] apply mul_le_mul_of_nonneg_right _ (hF T hT) apply mul_le_mul_of_nonneg_left _ (exp_pos _).le exact prod_le_prod (fun p hp ↦ hw p (hTP hp)) (fun p hp ↦ hodds p (hTP hp)) end Erdos859Verification end /- Inlined development module: PrimeSubsetBallot.lean -/ section /- The occupancy ballot condition as an event of actual finite prime subsets. -/ namespace Erdos859Verification open Finset Real noncomputable def primeSubsetBinCount {n : ℕ} (P : Finset ℕ) (bin : P → Fin n) (T : Finset ℕ) (j : Fin n) : ℕ := by classical exact (univ.filter (fun p : P ↦ p.val ∈ T ∧ bin p = j)).card def primeSubsetBallot {n : ℕ} (P : Finset ℕ) (bin : P → Fin n) (T : Finset ℕ) : Prop := CyclicBallot (primeSubsetBinCount P bin T) theorem primeSubsetBinCount_tupleSupport {n : ℕ} {P : Finset ℕ} (bin : P → Fin n) (x : Fin n → P) (hx : Function.Injective x) (j : Fin n) : primeSubsetBinCount P bin (tupleSupport x) j = occupancyCount (fun i ↦ bin (x i)) j := by classical have heq : univ.filter (fun p : P ↦ p.val ∈ tupleSupport x ∧ bin p = j) = (univ.filter (fun i : Fin n ↦ bin (x i) = j)).image x := by ext p constructor · intro hp obtain ⟨i, _, hi⟩ := mem_image.mp (mem_filter.mp hp).2.1 have hip : x i = p := Subtype.ext hi exact mem_image.mpr ⟨i, mem_filter.mpr ⟨mem_univ i, hip.symm ▸ (mem_filter.mp hp).2.2⟩, hip⟩ · intro hp obtain ⟨i, hi, rfl⟩ := mem_image.mp hp exact mem_filter.mpr ⟨mem_univ _, mem_image.mpr ⟨i, mem_univ i, rfl⟩, (mem_filter.mp hi).2⟩ unfold primeSubsetBinCount rw [heq, card_image_of_injective _ hx] simp [occupancyCount] theorem primeSubsetBallot_tupleSupport_iff {n : ℕ} {P : Finset ℕ} (bin : P → Fin n) (x : Fin n → P) (hx : Function.Injective x) : primeSubsetBallot P bin (tupleSupport x) ↔ CyclicBallot (occupancyCount (fun i ↦ bin (x i))) := by have heq : primeSubsetBinCount P bin (tupleSupport x) = occupancyCount (fun i ↦ bin (x i)) := funext (primeSubsetBinCount_tupleSupport bin x hx) simp only [primeSubsetBallot, heq] theorem finite_good_weight_minus_discarded {α : Type*} [Fintype α] (w : α → ℝ) (Good Keep : α → Prop) [DecidablePred Good] [DecidablePred Keep] (hw : ∀ x, 0 ≤ w x) : (∑ x ∈ univ.filter Good, w x) - (∑ x ∈ univ.filter (fun x ↦ ¬ Keep x), w x) ≤ ∑ x ∈ univ.filter (fun x ↦ Keep x ∧ Good x), w x := by classical rw [sum_filter, sum_filter, sum_filter, ← sum_sub_distrib] apply sum_le_sum intro x _ by_cases hg : Good x <;> by_cases hk : Keep x <;> simp [hg, hk, hw x] theorem finite_iid_unnormalized_duplicate_bound {α : Type*} [Fintype α] [DecidableEq α] (n : ℕ) (w : α → ℝ) (hw : ∀ x, 0 ≤ w x) {M alpha : ℝ} (hM : 0 < M) (hnorm : ∑ x, w x = M) (halpha : 0 ≤ alpha) (hatom : ∀ x, w x / M ≤ alpha) : (∑ x ∈ univ.filter (fun x : Fin n → α ↦ ¬ Function.Injective x), ∏ i, w (x i)) ≤ M ^ n * ((n : ℝ) ^ 2 * alpha) := by classical have hnorm' : ∑ x, w x / M = 1 := by rw [← sum_div, hnorm, div_self hM.ne'] have hd := finite_iid_duplicate_probability_le n (fun x ↦ w x / M) halpha (fun x ↦ div_nonneg (hw x) hM.le) hnorm' hatom have he (x : Fin n → α) : (∃ i j : Fin n, i ≠ j ∧ x i = x j) ↔ ¬ Function.Injective x := by rw [Function.not_injective_iff] aesop simp_rw [he] at hd have hp (x : Fin n → α) : finiteProductWeight (fun (_ : Fin n) y ↦ w y / M) x = (∏ i, w (x i)) / M ^ n := by rw [finiteProductWeight, prod_div_distrib] simp simp_rw [hp, mul_ite, mul_one, mul_zero] at hd rw [← sum_filter, ← sum_div] at hd have h := (div_le_iff₀ (pow_pos hM n)).mp hd simpa only [mul_comm] using h theorem primeTilt_ballot_count_lower {n : ℕ} {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) (bin : P → Fin n) {M L alpha : ℝ} (hM : 0 < M) (hMsum : ∑ p ∈ P, primeLogOddsIntensity lam p = M) (halpha : 0 ≤ alpha) (hatom : ∀ p ∈ P, primeLogOddsIntensity lam p / M ≤ alpha) (hballot : L ≤ ∑ x : Fin n → P with CyclicBallot (occupancyCount (fun i ↦ bin (x i))), ∏ i, primeLogOddsIntensity lam (x i).val) : exp (-M) / (n.factorial : ℝ) * (L - M ^ n * ((n : ℝ) ^ 2 * alpha)) ≤ primeTiltGoodCountMass P lam n (primeSubsetBallot P bin) := by classical let w : P → ℝ := fun p ↦ primeLogOddsIntensity lam p.val have hw (p : P) : 0 ≤ w p := (primeLogOddsIntensity_le_odds hlam (hP p.val p.property)).1 have hnorm : ∑ p, w p = M := by simpa only [w, Finset.sum_coe_sort] using hMsum have hd := finite_iid_unnormalized_duplicate_bound n w hw hM hnorm halpha (fun p ↦ hatom p.val p.property) have hg := finite_good_weight_minus_discarded (fun x : Fin n → P ↦ ∏ i, w (x i)) (fun x ↦ CyclicBallot (occupancyCount (fun i ↦ bin (x i)))) Function.Injective (fun x ↦ prod_nonneg (fun i _ ↦ hw (x i))) have hl : L - M ^ n * ((n : ℝ) ^ 2 * alpha) ≤ ∑ x ∈ univ.filter (fun x : Fin n → P ↦ Function.Injective x ∧ CyclicBallot (occupancyCount (fun i ↦ bin (x i)))), ∏ i, w (x i) := by exact (sub_le_sub hballot hd).trans hg have hcount := primeTilt_count_lower_from_unnormalized_marks hP hlam n (primeLogOddsIntensity lam) (fun T ↦ if primeSubsetBallot P bin T then 1 else 0) (fun p hp ↦ (primeLogOddsIntensity_le_odds hlam (hP p hp)).1) (fun p hp ↦ (primeLogOddsIntensity_le_odds hlam (hP p hp)).2) (fun T _ ↦ by split_ifs <;> norm_num) rw [hMsum] at hcount have ht : (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, primeLogOddsIntensity lam (x i).val) * (if primeSubsetBallot P bin (tupleSupport x) then 1 else 0)) = ∑ x ∈ univ.filter (fun x : Fin n → P ↦ Function.Injective x ∧ CyclicBallot (occupancyCount (fun i ↦ bin (x i)))), ∏ i, w (x i) := by rw [sum_filter, sum_filter] apply sum_congr rfl intro x _ by_cases hx : Function.Injective x · simp only [hx, if_true, true_and, primeSubsetBallot_tupleSupport_iff bin x hx, mul_ite, mul_one, mul_zero, w] · simp only [hx, if_false, false_and] rw [ht] at hcount have h := (mul_le_mul_of_nonneg_left hl (by positivity : 0 ≤ exp (-M) / (n.factorial : ℝ))).trans hcount simpa only [primeTiltGoodCountMass, sum_filter, mul_ite, mul_one, mul_zero, ite_and] using h end Erdos859Verification end /- Inlined development module: VirtualPrimeBins.lean -/ section /- Actual prime intensities on the increasing virtual-core bins. -/ open Finset Real namespace Erdos859Verification noncomputable def virtualPrimeBand (A B : ℝ) (j : ℕ) : Finset ℕ := primeLogWindow (A + B * 2 ^ j) (A + B * 2 ^ (j + 1)) noncomputable def virtualPrimeUniverse (A B : ℝ) (n : ℕ) : Finset ℕ := (range n).biUnion (virtualPrimeBand A B) noncomputable def virtualPrimeRelativeError (B : ℝ) : ℝ := 2 * primeLogOddsErrorConstant / (B * log 2) theorem virtualCoreBin_lower_fraction {A B : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (j : ℕ) : log 2 * B * 2 ^ j / (A + B * 2 ^ j) ≤ virtualCoreBin A B j := by have hp : (0 : ℝ) < 2 ^ j := by positivity have hd : 0 < A + B * 2 ^ j := by positivity have hd' : 0 < 1 + (A / B) / (2 : ℝ) ^ j := by positivity have he : log 2 * B * 2 ^ j / (A + B * 2 ^ j) = log 2 / (1 + (A / B) / (2 : ℝ) ^ j) := by field_simp ring rw [he] exact virtualCoreBin_lower hA hB j theorem virtualCoreBin_absorb_error {A B C : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hC : 0 ≤ C) (j : ℕ) : 2 * C / (A + B * 2 ^ j) ≤ (2 * C / (B * log 2)) * virtualCoreBin A B j := by have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hd : 0 < A + B * 2 ^ j := by positivity have hp : (1 : ℝ) ≤ 2 ^ j := one_le_pow₀ (by norm_num) calc _ ≤ (2 * C * 2 ^ j) / (A + B * 2 ^ j) := div_le_div_of_nonneg_right (by nlinarith) hd.le _ = (2 * C / (B * log 2)) * (log 2 * B * 2 ^ j / (A + B * 2 ^ j)) := by field_simp _ ≤ _ := mul_le_mul_of_nonneg_left (virtualCoreBin_lower_fraction hA hB j) (by positivity) theorem virtualPrime_normalized_mass_lower {A B lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (j : ℕ) : (1 - virtualPrimeRelativeError B) * virtualCoreBin A B j ≤ primeNormalizedLogOddsWindowMass lam (A + B * 2 ^ j) (A + B * 2 ^ (j + 1)) := by have hp : (1 : ℝ) ≤ 2 ^ j := one_le_pow₀ (by norm_num) have hu : log 2 ≤ A + B * 2 ^ j := by nlinarith have huv : A + B * 2 ^ j ≤ A + B * 2 ^ (j + 1) := by rw [pow_succ]; nlinarith have he := (abs_le.mp (primeNormalizedLogOddsWindowMass_estimate hlam hlam2 hu huv)).1 have hc := virtualCoreBin_absorb_error hA hB primeLogOddsErrorConstant_pos.le j change -(2 * primeLogOddsErrorConstant / (A + B * 2 ^ j)) ≤ primeNormalizedLogOddsWindowMass lam (A + B * 2 ^ j) (A + B * 2 ^ (j + 1)) - virtualCoreBin A B j at he unfold virtualPrimeRelativeError nlinarith theorem virtualPrime_intensity_mass_lower {A B lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (j : ℕ) : (lam * (1 - virtualPrimeRelativeError B)) * virtualCoreBin A B j ≤ ∑ p ∈ virtualPrimeBand A B j, primeLogOddsIntensity lam p := by have hlam0 : 0 < lam := by linarith have hm := mul_le_mul_of_nonneg_left (virtualPrime_normalized_mass_lower hA hB hbase hlam hlam2 j) hlam0.le have he : lam * primeNormalizedLogOddsWindowMass lam (A + B * 2 ^ j) (A + B * 2 ^ (j + 1)) = ∑ p ∈ virtualPrimeBand A B j, primeLogOddsIntensity lam p := by unfold primeNormalizedLogOddsWindowMass virtualPrimeBand rw [mul_sum] apply sum_congr rfl intro p _ field_simp rw [he] at hm simpa only [mul_assoc] using hm theorem virtualPrimeRelativeError_bounds {B : ℝ} (hB : 0 < B) (hlarge : 2 * primeLogOddsErrorConstant ≤ B * log 2) : 0 ≤ virtualPrimeRelativeError B ∧ virtualPrimeRelativeError B ≤ 1 := by have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) unfold virtualPrimeRelativeError exact ⟨by positivity [primeLogOddsErrorConstant_pos], (div_le_one (by positivity)).mpr hlarge⟩ theorem virtualPrimeBand_disjoint {A B : ℝ} (hB : 0 < B) {i j : ℕ} (hij : i ≠ j) : Disjoint (virtualPrimeBand A B i) (virtualPrimeBand A B j) := by apply disjoint_left.mpr intro p hpi hpj obtain ⟨_, hilo, hihi⟩ := mem_primeLogWindow.mp hpi obtain ⟨_, hjlo, hjhi⟩ := mem_primeLogWindow.mp hpj rcases lt_or_gt_of_ne hij with hij | hij · have hp : (2 : ℝ) ^ (i + 1) ≤ 2 ^ j := pow_le_pow_right₀ (by norm_num) (by omega) nlinarith · have hp : (2 : ℝ) ^ (j + 1) ≤ 2 ^ i := pow_le_pow_right₀ (by norm_num) (by omega) nlinarith theorem virtualPrimeBand_subset_universe (A B : ℝ) {n j : ℕ} (hj : j < n) : virtualPrimeBand A B j ⊆ virtualPrimeUniverse A B n := by intro p hp exact mem_biUnion.mpr ⟨j, mem_range.mpr hj, hp⟩ theorem virtualPrime_exists_bin (A B : ℝ) (n : ℕ) (p : virtualPrimeUniverse A B n) : ∃ j : Fin n, p.val ∈ virtualPrimeBand A B j.val := by obtain ⟨j, hj, hp⟩ := mem_biUnion.mp p.property exact ⟨⟨j, mem_range.mp hj⟩, hp⟩ noncomputable def virtualPrimeBinIndex (A B : ℝ) (n : ℕ) (p : virtualPrimeUniverse A B n) : Fin n := Classical.choose (virtualPrime_exists_bin A B n p) theorem virtualPrimeBinIndex_mem (A B : ℝ) (n : ℕ) (p : virtualPrimeUniverse A B n) : p.val ∈ virtualPrimeBand A B (virtualPrimeBinIndex A B n p).val := Classical.choose_spec (virtualPrime_exists_bin A B n p) theorem virtualPrimeBinIndex_eq_iff {A B : ℝ} (hB : 0 < B) (n : ℕ) (p : virtualPrimeUniverse A B n) (j : Fin n) : virtualPrimeBinIndex A B n p = j ↔ p.val ∈ virtualPrimeBand A B j.val := by constructor · intro h simpa only [h] using virtualPrimeBinIndex_mem A B n p · intro hp apply Fin.ext by_contra h exact (disjoint_left.mp (virtualPrimeBand_disjoint hB h)) (virtualPrimeBinIndex_mem A B n p) hp /-- The chosen bin classifier has exactly the actual prime-window masses. -/ theorem virtualPrime_finiteBinMass_eq {A B : ℝ} (hB : 0 < B) (n : ℕ) (weight : ℕ → ℝ) (j : Fin n) : finiteBinMass (fun p : virtualPrimeUniverse A B n ↦ weight p.val) (virtualPrimeBinIndex A B n) j = ∑ p ∈ virtualPrimeBand A B j.val, weight p := by classical unfold finiteBinMass apply sum_bij (fun p _ ↦ p.val) · intro p hp exact (virtualPrimeBinIndex_eq_iff hB n p j).mp (mem_filter.mp hp).2 · intro p _ q _ hpq exact Subtype.ext hpq · intro p hp let q : virtualPrimeUniverse A B n := ⟨p, virtualPrimeBand_subset_universe A B j.isLt hp⟩ exact ⟨q, mem_filter.mpr ⟨mem_univ _, (virtualPrimeBinIndex_eq_iff hB n q j).mpr hp⟩, rfl⟩ · intro p _ rfl theorem virtualPrimeUniverse_eq_window {A B : ℝ} (hB : 0 < B) (n : ℕ) : virtualPrimeUniverse A B n = primeLogWindow (A + B) (A + B * 2 ^ n) := by induction n with | zero => ext p simp only [virtualPrimeUniverse, range_zero, biUnion_empty, notMem_empty, mem_primeLogWindow, pow_zero, mul_one] exact ⟨False.elim, fun ⟨_, hlo, hhi⟩ ↦ (not_lt_of_ge hhi) hlo⟩ | succ n ih => have hp : (1 : ℝ) ≤ 2 ^ n := one_le_pow₀ (by norm_num) have hab : A + B ≤ A + B * 2 ^ n := by nlinarith have hbc : A + B * 2 ^ n ≤ A + B * 2 ^ (n + 1) := by rw [pow_succ]; nlinarith calc virtualPrimeUniverse A B (n + 1) = virtualPrimeUniverse A B n ∪ virtualPrimeBand A B n := by simp only [virtualPrimeUniverse, range_add_one, biUnion_insert, union_comm] _ = _ := by rw [ih, virtualPrimeBand, primeLogWindow_union_adjacent hab hbc] /-- Actual prime intensity weights satisfy the corrected virtual-bin ballot bound, with no bin-mass premise left unproved. -/ theorem virtualPrime_ballot_intensity_lower {n : ℕ} (hn : 0 < n) {A B lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 2 * primeLogOddsErrorConstant ≤ B * log 2) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) : ((n : ℝ) ^ n / n) * (lam * (1 - virtualPrimeRelativeError B) * log 2) ^ n * exp (-(J : ℝ) * log (1 + A / B) - 2) ≤ ∑ x : Fin n → virtualPrimeUniverse A B n with CyclicBallot (occupancyCount (fun i ↦ virtualPrimeBinIndex A B n (x i))), ∏ i, primeLogOddsIntensity lam (x i).val := by have hcoef : 0 ≤ lam * (1 - virtualPrimeRelativeError B) := mul_nonneg (by linarith) (sub_nonneg.mpr (virtualPrimeRelativeError_bounds hB hlarge).2) have hbin (j : Fin n) : (lam * (1 - virtualPrimeRelativeError B)) * virtualCoreBin A B j.val ≤ finiteBinMass (fun p : virtualPrimeUniverse A B n ↦ primeLogOddsIntensity lam p.val) (virtualPrimeBinIndex A B n) j := by rw [virtualPrime_finiteBinMass_eq hB] exact virtualPrime_intensity_mass_lower hA hB hbase hlam hlam2 j.val exact virtual_core_ballot_weight_lower hn (fun p : virtualPrimeUniverse A B n ↦ primeLogOddsIntensity lam p.val) (virtualPrimeBinIndex A B n) hA hB hcoef hAB hbin end Erdos859Verification end /- Inlined development module: VirtualPrimeSubsetBallot.lean -/ section /- A concrete ballot event under the actual tilted prime-subset law. -/ namespace Erdos859Verification open Finset Real theorem virtualPrime_relative_error_le_half {B : ℝ} (hB : 0 < B) (hlarge : 4 * primeLogOddsErrorConstant ≤ B * log 2) : virtualPrimeRelativeError B ≤ 1 / 2 := by have hd : 0 < B * log 2 := mul_pos hB (log_pos (by norm_num)) unfold virtualPrimeRelativeError apply (div_le_iff₀ hd).mpr linarith theorem virtualPrime_intensity_mass_pos {n : ℕ} (hn : 0 < n) {A B lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ B * log 2) : 0 < ∑ p ∈ virtualPrimeUniverse A B n, primeLogOddsIntensity lam p := by have hxi := virtualPrime_relative_error_le_half hB hlarge have hlp : 0 < lam := zero_lt_one.trans_le hlam have hcoef : 0 < lam * (1 - virtualPrimeRelativeError B) := mul_pos hlp (by linarith) have hfirst : 0 < ∑ p ∈ virtualPrimeBand A B 0, primeLogOddsIntensity lam p := (mul_pos hcoef (virtualCoreBin_pos hA hB 0)).trans_le (virtualPrime_intensity_mass_lower hA hB hbase hlam hlam2 0) apply hfirst.trans_le apply sum_le_sum_of_subset_of_nonneg (virtualPrimeBand_subset_universe A B hn) intro p hp _ rw [virtualPrimeUniverse_eq_window hB] at hp exact (primeLogOddsIntensity_le_odds hlp (mem_primeLogWindow.mp hp).1).1 theorem virtualPrime_intensity_atom_le {n : ℕ} {A B lam M : ℝ} (hB : 0 < B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hM : 0 < M) {p : ℕ} (hp : p ∈ virtualPrimeUniverse A B n) : primeLogOddsIntensity lam p / M ≤ 4 * exp (-(A + B)) / M := by rw [virtualPrimeUniverse_eq_window hB] at hp have hp' := mem_primeLogWindow.mp hp have hp0 : (0 : ℝ) < p := by exact_mod_cast hp'.1.pos have hr : 1 / (p : ℝ) ≤ exp (-(A + B)) := by rw [exp_neg, ← one_div] exact one_div_le_one_div_of_le (exp_pos _) ((lt_log_iff_exp_lt hp0).mp hp'.2.1).le apply div_le_div_of_nonneg_right _ hM.le calc _ ≤ 4 / (p : ℝ) := (primeLogOddsIntensity_bounds hlam hlam2 hp'.1).2 _ ≤ _ := by simpa only [mul_one_div] using mul_le_mul_of_nonneg_left hr (by norm_num : (0 : ℝ) ≤ 4) noncomputable def virtualPrimeBallotMass (A B lam : ℝ) (n : ℕ) : ℝ := primeTiltGoodCountMass (virtualPrimeUniverse A B n) lam n (primeSubsetBallot (virtualPrimeUniverse A B n) (virtualPrimeBinIndex A B n)) theorem virtualPrime_ballot_subset_mass_lower {n : ℕ} (hn : 0 < n) {A B lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ B * log 2) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) : let M := ∑ p ∈ virtualPrimeUniverse A B n, primeLogOddsIntensity lam p exp (-M) / (n.factorial : ℝ) * (((n : ℝ) ^ n / n) * (lam * (1 - virtualPrimeRelativeError B) * log 2) ^ n * exp (-(J : ℝ) * log (1 + A / B) - 2) - M ^ n * ((n : ℝ) ^ 2 * (4 * exp (-(A + B)) / M))) ≤ virtualPrimeBallotMass A B lam n := by have hM := virtualPrime_intensity_mass_pos hn hA hB hbase hlam hlam2 hlarge have hP (p : ℕ) (hp : p ∈ virtualPrimeUniverse A B n) : p.Prime := by rw [virtualPrimeUniverse_eq_window hB] at hp exact (mem_primeLogWindow.mp hp).1 have hlarge' : 2 * primeLogOddsErrorConstant ≤ B * log 2 := by linarith [primeLogOddsErrorConstant_pos] exact primeTilt_ballot_count_lower hP (zero_lt_one.trans_le hlam) (virtualPrimeBinIndex A B n) hM rfl (by positivity) (fun _ hp ↦ virtualPrime_intensity_atom_le hB hlam hlam2 hM hp) (virtualPrime_ballot_intensity_lower hn hA hB hbase hlam hlam2 hlarge' hAB) end Erdos859Verification end /- Inlined development module: VirtualPrimeBallotCost.lean -/ section /- The explicit exponential cost of the actual virtual-prime ballot mass. -/ open Finset Real namespace Erdos859Verification theorem virtualPrime_total_intensity_upper {A B lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (n : ℕ) : (∑ p ∈ virtualPrimeUniverse A B n, primeLogOddsIntensity lam p) ≤ lam * n * log 2 + 2 * lam * primeLogOddsErrorConstant / (A + B) := by have hu : 0 < A + B := by positivity have hlam0 : 0 < lam := by linarith have hp : (1 : ℝ) ≤ 2 ^ n := one_le_pow₀ (by norm_num) have huv : A + B ≤ A + B * 2 ^ n := by nlinarith have hv : 0 < A + B * 2 ^ n := by positivity have hratio : (A + B * 2 ^ n) / (A + B) ≤ (2 : ℝ) ^ n := by apply (div_le_iff₀ hu).mpr nlinarith have hlog : log ((A + B * 2 ^ n) / (A + B)) ≤ n * log 2 := by have h := log_le_log (div_pos hv hu) hratio simpa only [log_pow] using h have hm := (abs_le.mp (primeNormalizedLogOddsWindowMass_estimate hlam hlam2 hbase huv)).2 have hmass : primeNormalizedLogOddsWindowMass lam (A + B) (A + B * 2 ^ n) ≤ n * log 2 + 2 * primeLogOddsErrorConstant / (A + B) := by linarith have he : (∑ p ∈ virtualPrimeUniverse A B n, primeLogOddsIntensity lam p) = lam * primeNormalizedLogOddsWindowMass lam (A + B) (A + B * 2 ^ n) := by rw [virtualPrimeUniverse_eq_window hB] unfold primeNormalizedLogOddsWindowMass rw [mul_sum] apply sum_congr rfl intro p _ field_simp rw [he] calc _ ≤ lam * (n * log 2 + 2 * primeLogOddsErrorConstant / (A + B)) := mul_le_mul_of_nonneg_left hmass hlam0.le _ = _ := by ring theorem log_one_sub_ge_neg_two_mul {xi : ℝ} (hxi : 0 ≤ xi) (hxi2 : xi ≤ 1 / 2) : -2 * xi ≤ log (1 - xi) := by have hd : 0 < 1 - xi := by linarith have h := one_sub_inv_le_log_of_pos hd have hinv : (1 - xi)⁻¹ ≤ 1 + 2 * xi := by rw [← one_div] apply (div_le_iff₀ hd).mpr nlinarith [mul_le_mul_of_nonneg_left hxi2 hxi] linarith theorem one_sub_pow_ge_exp_loss {xi : ℝ} (hxi : 0 ≤ xi) (hxi2 : xi ≤ 1 / 2) (n : ℕ) : exp (-2 * (n : ℝ) * xi) ≤ (1 - xi) ^ n := by have hd : 0 < 1 - xi := by linarith have h := mul_le_mul_of_nonneg_left (log_one_sub_ge_neg_two_mul hxi hxi2) (Nat.cast_nonneg n) calc _ ≤ exp ((n : ℝ) * log (1 - xi)) := exp_le_exp.mpr (by nlinarith) _ = _ := by rw [exp_nat_mul, exp_log hd] /-- Separate the exact main rate from the deterministic intensity, virtual-bin, and relative Mertens losses. -/ theorem ballot_cost_after_relative_loss {n : ℕ} (hn : 0 < n) {theta xi M W err D : ℝ} (htheta : 0 < theta) (hxi : 0 ≤ xi) (hxi2 : xi ≤ 1 / 2) (hM : M ≤ theta * n + err) (hW : ((n : ℝ) ^ n / n) * (theta * (1 - xi)) ^ n * exp (-D) ≤ W) : exp (-(n : ℝ) * (theta - 1 - log theta) - err - D - 2 * n * xi) / (exp 1 * (n : ℝ) ^ 2) ≤ exp (-M) / n.factorial * W := by have hnR : (0 : ℝ) < n := by exact_mod_cast hn have hfR : (0 : ℝ) < n.factorial := by exact_mod_cast Nat.factorial_pos n have hxip : 0 < 1 - xi := by linarith have hmain := poisson_ballot_cost_lower htheta hn have hpow := one_sub_pow_ge_exp_loss hxi hxi2 n have heM : exp (-theta * n - err) ≤ exp (-M) := exp_le_exp.mpr (by linarith) calc _ = (exp (-(n : ℝ) * (theta - 1 - log theta)) / (exp 1 * (n : ℝ) ^ 2) * exp (-err - D)) * exp (-2 * n * xi) := by rw [show -(n : ℝ) * (theta - 1 - log theta) - err - D - 2 * n * xi = (-(n : ℝ) * (theta - 1 - log theta) + (-err - D)) + (-2 * n * xi) by ring, exp_add, exp_add] ring _ ≤ (exp (-theta * n) * (theta * n) ^ n / n.factorial / n * exp (-err - D)) * (1 - xi) ^ n := mul_le_mul (mul_le_mul_of_nonneg_right hmain (exp_pos _).le) hpow (exp_pos _).le (by positivity) _ = exp (-theta * n - err) / n.factorial * (((n : ℝ) ^ n / n) * (theta * (1 - xi)) ^ n * exp (-D)) := by simp only [mul_pow, exp_sub, exp_neg] ring _ ≤ _ := mul_le_mul (div_le_div_of_nonneg_right heM hfR.le) hW (by positivity) (by positivity) /-- Explicit finite main rate for the actual prime ballot weights, before the separate subtraction of repeated-prime tuples. -/ theorem virtualPrime_ballot_exponential_cost_lower {n : ℕ} (hn : 0 < n) {A B lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ B * log 2) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) : exp (-(n : ℝ) * (lam * log 2 - 1 - log (lam * log 2)) - 2 * lam * primeLogOddsErrorConstant / (A + B) - J * log (1 + A / B) - 2 - 2 * n * virtualPrimeRelativeError B) / (exp 1 * (n : ℝ) ^ 2) ≤ exp (-(∑ p ∈ virtualPrimeUniverse A B n, primeLogOddsIntensity lam p)) / n.factorial * (∑ x : Fin n → virtualPrimeUniverse A B n with CyclicBallot (occupancyCount (fun i ↦ virtualPrimeBinIndex A B n (x i))), ∏ i, primeLogOddsIntensity lam (x i).val) := by have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hlarge' : 2 * primeLogOddsErrorConstant ≤ B * log 2 := by linarith [primeLogOddsErrorConstant_pos] have hxi := (virtualPrimeRelativeError_bounds hB hlarge').1 have hxi2 : virtualPrimeRelativeError B ≤ 1 / 2 := by unfold virtualPrimeRelativeError apply (div_le_iff₀ (mul_pos hB hlog)).mpr linarith have hM : (∑ p ∈ virtualPrimeUniverse A B n, primeLogOddsIntensity lam p) ≤ (lam * log 2) * n + 2 * lam * primeLogOddsErrorConstant / (A + B) := by simpa only [mul_assoc, mul_comm, mul_left_comm] using virtualPrime_total_intensity_upper hA hB hbase hlam hlam2 n have hW := virtualPrime_ballot_intensity_lower hn hA hB hbase hlam hlam2 hlarge' hAB have hW' : ((n : ℝ) ^ n / n) * ((lam * log 2) * (1 - virtualPrimeRelativeError B)) ^ n * exp (-(J * log (1 + A / B) + 2)) ≤ ∑ x : Fin n → virtualPrimeUniverse A B n with CyclicBallot (occupancyCount (fun i ↦ virtualPrimeBinIndex A B n (x i))), ∏ i, primeLogOddsIntensity lam (x i).val := by rw [show (lam * log 2) * (1 - virtualPrimeRelativeError B) = lam * (1 - virtualPrimeRelativeError B) * log 2 by ring, show -(J * log (1 + A / B) + 2) = -(J : ℝ) * log (1 + A / B) - 2 by ring] exact hW have h := ballot_cost_after_relative_loss hn (mul_pos (by linarith : 0 < lam) hlog) hxi hxi2 hM hW' simpa only [sub_add_eq_sub_sub] using h end Erdos859Verification end /- Inlined development module: VirtualPrimeBallotProbability.lean -/ section /- An explicit main exponential rate for the actual subset ballot event, with a deterministic exponentially small repeated-mark error. -/ namespace Erdos859Verification open Finset Real theorem poisson_count_factor_le_one {M : ℝ} (hM : 0 ≤ M) (n : ℕ) : exp (-M) * M ^ n / (n.factorial : ℝ) ≤ 1 := by calc _ = exp (-M) * (M ^ n / (n.factorial : ℝ)) := by ring _ ≤ exp (-M) * exp M := mul_le_mul_of_nonneg_left (pow_div_factorial_le_exp M hM n) (exp_pos _).le _ = 1 := by rw [← exp_add, neg_add_cancel, exp_zero] theorem virtualPrime_intensity_mass_lower_explicit {n : ℕ} (hn : 0 < n) {A B lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ B * log 2) : B * log 2 / (2 * (A + B)) ≤ ∑ p ∈ virtualPrimeUniverse A B n, primeLogOddsIntensity lam p := by have hxi := virtualPrime_relative_error_le_half hB hlarge have hcoef : (1 : ℝ) / 2 ≤ lam * (1 - virtualPrimeRelativeError B) := by nlinarith have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hden : 0 < 1 + A / B := by positivity have heq : B * log 2 / (2 * (A + B)) = (1 / 2 : ℝ) * (log 2 / (1 + A / B)) := by field_simp ring calc _ = (1 / 2 : ℝ) * (log 2 / (1 + A / B)) := heq _ ≤ (1 / 2 : ℝ) * virtualCoreBin A B 0 := by apply mul_le_mul_of_nonneg_left _ (by norm_num) simpa only [pow_zero, div_one] using virtualCoreBin_lower hA hB 0 _ ≤ lam * (1 - virtualPrimeRelativeError B) * virtualCoreBin A B 0 := mul_le_mul_of_nonneg_right hcoef (virtualCoreBin_pos hA hB 0).le _ ≤ ∑ p ∈ virtualPrimeBand A B 0, primeLogOddsIntensity lam p := virtualPrime_intensity_mass_lower hA hB hbase hlam hlam2 0 _ ≤ _ := by apply sum_le_sum_of_subset_of_nonneg (virtualPrimeBand_subset_universe A B hn) intro p hp _ rw [virtualPrimeUniverse_eq_window hB] at hp exact (primeLogOddsIntensity_le_odds (zero_lt_one.trans_le hlam) (mem_primeLogWindow.mp hp).1).1 theorem virtualPrime_ballot_probability_explicit_lower {n : ℕ} (hn : 0 < n) {A B lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ B * log 2) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) : exp (-(n : ℝ) * (lam * log 2 - 1 - log (lam * log 2)) - 2 * lam * primeLogOddsErrorConstant / (A + B) - J * log (1 + A / B) - 2 - 2 * n * virtualPrimeRelativeError B) / (exp 1 * (n : ℝ) ^ 2) - (8 * (n : ℝ) ^ 2 * (A + B) / (B * log 2)) * exp (-(A + B)) ≤ virtualPrimeBallotMass A B lam n := by classical let P := virtualPrimeUniverse A B n let M := ∑ p ∈ P, primeLogOddsIntensity lam p let W := ∑ x : Fin n → P with CyclicBallot (occupancyCount (fun i ↦ virtualPrimeBinIndex A B n (x i))), ∏ i, primeLogOddsIntensity lam (x i).val let alpha := 4 * exp (-(A + B)) / M have hM : 0 < M := virtualPrime_intensity_mass_pos hn hA hB hbase hlam hlam2 hlarge have halpha : 0 ≤ alpha := by dsimp [alpha]; positivity have hP (p : ℕ) (hp : p ∈ P) : p.Prime := by change p ∈ virtualPrimeUniverse A B n at hp rw [virtualPrimeUniverse_eq_window hB] at hp exact (mem_primeLogWindow.mp hp).1 have hs := primeTilt_ballot_count_lower hP (zero_lt_one.trans_le hlam) (virtualPrimeBinIndex A B n) hM rfl halpha (fun _ hp ↦ virtualPrime_intensity_atom_le hB hlam hlam2 hM hp) (le_refl W) have hmain := virtualPrime_ballot_exponential_cost_lower hn hA hB hbase hlam hlam2 hlarge hAB have hdup : exp (-M) / (n.factorial : ℝ) * (M ^ n * ((n : ℝ) ^ 2 * alpha)) ≤ (n : ℝ) ^ 2 * alpha := by calc _ = (exp (-M) * M ^ n / (n.factorial : ℝ)) * ((n : ℝ) ^ 2 * alpha) := by ring _ ≤ 1 * ((n : ℝ) ^ 2 * alpha) := mul_le_mul_of_nonneg_right (poisson_count_factor_le_one hM.le n) (by positivity) _ = _ := one_mul _ have hlo : B * log 2 / (2 * (A + B)) ≤ M := virtualPrime_intensity_mass_lower_explicit hn hA hB hbase hlam hlam2 hlarge have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hab : 0 < A + B := by positivity have ha : alpha ≤ (8 * (A + B) / (B * log 2)) * exp (-(A + B)) := by calc _ ≤ (4 * exp (-(A + B))) / (B * log 2 / (2 * (A + B))) := div_le_div_of_nonneg_left (by positivity) (by positivity) hlo _ = _ := by field_simp; ring have he : (n : ℝ) ^ 2 * alpha ≤ (8 * (n : ℝ) ^ 2 * (A + B) / (B * log 2)) * exp (-(A + B)) := by calc _ ≤ (n : ℝ) ^ 2 * ((8 * (A + B) / (B * log 2)) * exp (-(A + B))) := mul_le_mul_of_nonneg_left ha (sq_nonneg (n : ℝ)) _ = _ := by ring calc _ ≤ _ - (n : ℝ) ^ 2 * alpha := sub_le_sub_left he _ _ ≤ exp (-M) / (n.factorial : ℝ) * W - exp (-M) / (n.factorial : ℝ) * (M ^ n * ((n : ℝ) ^ 2 * alpha)) := sub_le_sub hmain hdup _ = exp (-M) / (n.factorial : ℝ) * (W - M ^ n * ((n : ℝ) ^ 2 * alpha)) := by ring _ ≤ _ := hs end Erdos859Verification end /- Inlined development module: CoreBallotParameters.lean -/ section /- Concrete polynomial parameters have zero cost in the finite ballot rate. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification noncomputable def coreBallotShift (k : ℕ) : ℝ := 10 * (k : ℝ) ^ 3 noncomputable def coreBallotScale (k : ℕ) : ℝ := (501 / 500 : ℝ) * ((k : ℝ) ^ 2 + 3) noncomputable def coreBallotHeadCount (k : ℕ) : ℕ := ⌈sqrt (k : ℝ)⌉₊ theorem coreBallotHeadCount_eq_rpow (k : ℕ) : coreBallotHeadCount k = ⌈(k : ℝ) ^ (1 / 2 : ℝ)⌉₊ := by simp only [coreBallotHeadCount, sqrt_eq_rpow] theorem coreBallotShift_nonneg (k : ℕ) : 0 ≤ coreBallotShift k := by unfold coreBallotShift positivity theorem coreBallotScale_pos (k : ℕ) : 0 < coreBallotScale k := by unfold coreBallotScale positivity theorem coreBallotScale_ge_nat (k : ℕ) : (k : ℝ) ≤ coreBallotScale k := by unfold coreBallotScale nlinarith [sq_nonneg ((k : ℝ) - 1 / 2)] theorem coreBallotShift_div_scale_le (k : ℕ) : coreBallotShift k / coreBallotScale k ≤ 10 * k := by apply (div_le_iff₀ (coreBallotScale_pos k)).mpr unfold coreBallotShift coreBallotScale nlinarith [pow_nonneg (Nat.cast_nonneg (α := ℝ) k) 3, Nat.cast_nonneg (α := ℝ) k] theorem coreBallot_base_large (k : ℕ) : log 2 ≤ coreBallotShift k + coreBallotScale k := by have hlog : log (2 : ℝ) ≤ 1 := by have h := log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) norm_num at h exact h have hA := coreBallotShift_nonneg k unfold coreBallotScale nlinarith [sq_nonneg (k : ℝ)] theorem coreBallotScale_tendsto : Tendsto coreBallotScale atTop atTop := tendsto_atTop_mono coreBallotScale_ge_nat (tendsto_natCast_atTop_atTop (R := ℝ)) theorem coreBallotShift_add_scale_tendsto : Tendsto (fun k ↦ coreBallotShift k + coreBallotScale k) atTop atTop := tendsto_atTop_mono (fun k ↦ by linarith [coreBallotShift_nonneg k]) coreBallotScale_tendsto theorem coreBallotScale_eventually_mertens_large : ∀ᶠ k in atTop, 4 * primeLogOddsErrorConstant ≤ coreBallotScale k * log 2 := by have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) filter_upwards [coreBallotScale_tendsto.eventually_ge_atTop (4 * primeLogOddsErrorConstant / log 2)] with k hk exact (div_le_iff₀ hlog).mp hk theorem tendsto_log_nat_div_sqrt : Tendsto (fun k : ℕ ↦ log (k : ℝ) / sqrt (k : ℝ)) atTop (𝓝 0) := by simpa only [Function.comp_def, sqrt_eq_rpow] using (isLittleO_log_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 2)).tendsto_div_nhds_zero.comp (tendsto_natCast_atTop_atTop (R := ℝ)) theorem tendsto_const_add_log_nat_div_sqrt (c : ℝ) : Tendsto (fun k : ℕ ↦ (c + log (k : ℝ)) / sqrt (k : ℝ)) atTop (𝓝 0) := by have hs : Tendsto (fun k : ℕ ↦ sqrt (k : ℝ)) atTop atTop := tendsto_sqrt_atTop.comp (tendsto_natCast_atTop_atTop (R := ℝ)) simpa only [add_div, zero_add] using (hs.const_div_atTop c).add tendsto_log_nat_div_sqrt theorem coreBallotHeadCount_sqrt_bounds (k : ℕ) : sqrt (k : ℝ) ≤ (coreBallotHeadCount k : ℝ) ∧ (coreBallotHeadCount k : ℝ) ≤ sqrt (k : ℝ) + 1 := ⟨Nat.le_ceil _, (Nat.ceil_lt_add_one (sqrt_nonneg _)).le⟩ theorem coreBallotHeadCount_le_two_sqrt {k : ℕ} (hk : 0 < k) : (coreBallotHeadCount k : ℝ) ≤ 2 * sqrt (k : ℝ) := by have hkR : (1 : ℝ) ≤ k := by exact_mod_cast hk have hs := one_le_sqrt.mpr hkR linarith [(coreBallotHeadCount_sqrt_bounds k).2] theorem coreBallot_ratio_eventually_le_pow_head : ∀ᶠ k in atTop, coreBallotShift k / coreBallotScale k ≤ (2 : ℝ) ^ coreBallotHeadCount k := by have hlog2 : 0 < log (2 : ℝ) := log_pos (by norm_num) filter_upwards [(tendsto_const_add_log_nat_div_sqrt (log 10)).eventually_lt_const hlog2, eventually_gt_atTop 0] with k hsmall hk have hkR : (0 : ℝ) < k := by exact_mod_cast hk have hs : 0 < sqrt (k : ℝ) := sqrt_pos.mpr hkR have hsmall' := (div_lt_iff₀ hs).mp hsmall have hceil := mul_le_mul_of_nonneg_right (coreBallotHeadCount_sqrt_bounds k).1 hlog2.le have hbound : 10 * (k : ℝ) ≤ (2 : ℝ) ^ coreBallotHeadCount k := by apply (log_le_log_iff (by positivity) (by positivity)).mp rw [log_mul (by norm_num) hkR.ne', log_pow] nlinarith exact (coreBallotShift_div_scale_le k).trans hbound theorem coreBallot_log_ratio_upper {k : ℕ} (hk : 0 < k) : log (1 + coreBallotShift k / coreBallotScale k) ≤ log 11 + log (k : ℝ) := by have hkR : (1 : ℝ) ≤ k := by exact_mod_cast hk have hkpos : (0 : ℝ) < k := by exact_mod_cast hk have hquot : 0 ≤ coreBallotShift k / coreBallotScale k := div_nonneg (coreBallotShift_nonneg k) (coreBallotScale_pos k).le have h := log_le_log (by positivity : 0 < 1 + coreBallotShift k / coreBallotScale k) (show 1 + coreBallotShift k / coreBallotScale k ≤ 11 * (k : ℝ) by linarith [coreBallotShift_div_scale_le k]) rwa [log_mul (by norm_num) hkpos.ne'] at h theorem coreBallot_head_error_div_upper {k : ℕ} (hk : 0 < k) : (coreBallotHeadCount k : ℝ) * log (1 + coreBallotShift k / coreBallotScale k) / k ≤ 2 * ((log 11 + log (k : ℝ)) / sqrt (k : ℝ)) := by have hquot : 0 ≤ coreBallotShift k / coreBallotScale k := div_nonneg (coreBallotShift_nonneg k) (coreBallotScale_pos k).le have hl : 0 ≤ log (1 + coreBallotShift k / coreBallotScale k) := log_nonneg (by linarith) have hm := mul_le_mul (coreBallotHeadCount_le_two_sqrt hk) (coreBallot_log_ratio_upper hk) hl (by positivity) calc _ ≤ (2 * sqrt (k : ℝ) * (log 11 + log (k : ℝ))) / k := div_le_div_of_nonneg_right hm (Nat.cast_nonneg k) _ = 2 * (log 11 + log (k : ℝ)) * (sqrt (k : ℝ) / k) := by ring _ = _ := by rw [sqrt_div_self']; ring theorem coreBallot_head_error_div_tendsto : Tendsto (fun k : ℕ ↦ (coreBallotHeadCount k : ℝ) * log (1 + coreBallotShift k / coreBallotScale k) / k) atTop (𝓝 0) := by have hlim : Tendsto (fun k : ℕ ↦ 2 * ((log 11 + log (k : ℝ)) / sqrt (k : ℝ))) atTop (𝓝 0) := by simpa using (tendsto_const_add_log_nat_div_sqrt (log 11)).const_mul 2 apply squeeze_zero' _ _ hlim · exact Eventually.of_forall fun k ↦ div_nonneg (mul_nonneg (Nat.cast_nonneg _) (log_nonneg (by have h := div_nonneg (coreBallotShift_nonneg k) (coreBallotScale_pos k).le linarith))) (Nat.cast_nonneg k) · exact (eventually_gt_atTop 0).mono fun _ hk ↦ coreBallot_head_error_div_upper hk theorem coreBallot_relative_error_tendsto : Tendsto (fun k ↦ virtualPrimeRelativeError (coreBallotScale k)) atTop (𝓝 0) := by have h := (coreBallotScale_tendsto.const_div_atTop (2 * primeLogOddsErrorConstant)).div_const (log 2) simpa only [virtualPrimeRelativeError, div_div, zero_div] using h noncomputable def coreBallotError (lam : ℝ) (k : ℕ) : ℝ := 2 * lam * primeLogOddsErrorConstant / (coreBallotShift k + coreBallotScale k) + (coreBallotHeadCount k : ℝ) * log (1 + coreBallotShift k / coreBallotScale k) + 2 + 2 * k * virtualPrimeRelativeError (coreBallotScale k) /-- Every displayed correction to the finite ballot rate is `o(k)`. The result holds for every fixed real tilt; later applications restrict it to `[1,2]`. -/ theorem coreBallot_error_div_tendsto (lam : ℝ) : Tendsto (fun k : ℕ ↦ coreBallotError lam k / k) atTop (𝓝 0) := by have hnat : Tendsto (fun k : ℕ ↦ (k : ℝ)) atTop atTop := tendsto_natCast_atTop_atTop have hfirst := (coreBallotShift_add_scale_tendsto.const_div_atTop (2 * lam * primeLogOddsErrorConstant)).div_atTop hnat have hlast : Tendsto (fun k : ℕ ↦ (2 * k * virtualPrimeRelativeError (coreBallotScale k)) / k) atTop (𝓝 0) := by apply (show Tendsto (fun k ↦ 2 * virtualPrimeRelativeError (coreBallotScale k)) atTop (𝓝 0) by simpa using coreBallot_relative_error_tendsto.const_mul 2).congr' filter_upwards [eventually_gt_atTop 0] with k hk have hkR : (k : ℝ) ≠ 0 := by exact_mod_cast hk.ne' field_simp simpa only [coreBallotError, add_div, zero_add] using ((hfirst.add coreBallot_head_error_div_tendsto).add (tendsto_const_div_atTop_nhds_zero_nat (2 : ℝ))).add hlast theorem coreBallot_parameters_eventually_admissible : ∀ᶠ k in atTop, 0 < k ∧ 0 ≤ coreBallotShift k ∧ 0 < coreBallotScale k ∧ log 2 ≤ coreBallotShift k + coreBallotScale k ∧ 4 * primeLogOddsErrorConstant ≤ coreBallotScale k * log 2 ∧ coreBallotShift k / coreBallotScale k ≤ (2 : ℝ) ^ coreBallotHeadCount k := by filter_upwards [eventually_gt_atTop 0, coreBallotScale_eventually_mertens_large, coreBallot_ratio_eventually_le_pow_head] with k hk hlarge hratio exact ⟨hk, coreBallotShift_nonneg k, coreBallotScale_pos k, coreBallot_base_large k, hlarge, hratio⟩ end Erdos859Verification end /- Inlined development module: PhaseBlockDecay.lean -/ section /- Uniform algebraic decay of rational phase blocks at proper-cube anchors. -/ namespace Erdos859Verification open Real noncomputable def rationalPhaseBlockBound (m : ℕ) (G M R Q Pmin : ℝ) : ℝ := 12 * (6 * G) ^ m * (1 + 2 * Q / Pmin) ^ m * (2 * Q + R) ^ (m + 1) / (M ^ (m + 1) * Q ^ (m - 1)) theorem phaseBlock_coefficient_le (m : ℕ) {c : ℝ} (hc : 0 ≤ c) (hc1 : c ≤ 1000) : 36 * c ^ m ≤ (1000 : ℝ) ^ (m + 1) := by calc _ ≤ (1000 : ℝ) * 1000 ^ m := mul_le_mul (by norm_num) (pow_le_pow_left₀ hc hc1 m) (pow_nonneg hc m) (by norm_num) _ = _ := by rw [pow_succ]; ring theorem phaseBlock_power_ratio {M : ℝ} (hM : 0 < M) (u : ℝ) (k l n : ℕ) : (M ^ u) ^ k / (M ^ l * M ^ n) = M ^ (u * (k : ℝ) - ((l : ℝ) + (n : ℝ))) := by rw [← rpow_mul_natCast hM.le, ← rpow_natCast M l, ← rpow_natCast M n, ← rpow_add hM, ← rpow_sub hM] theorem phaseBlock_cancel_powers {M Q : ℝ} (hM : 0 < M) (hQ : 0 < Q) {m : ℕ} (hm : 1 ≤ m) : Q ^ (m + 1) / (M ^ (m + 1) * Q ^ (m - 1)) = Q ^ 2 / M ^ (m + 1) := by cases m with | zero => omega | succ n => simp only [Nat.add_sub_cancel, pow_succ] field_simp /-- Separate the harmless numerical coefficient from the decisive scale ratio. -/ theorem rationalPhaseBlockBound_le_scale {m : ℕ} {G M R Q Pmin V : ℝ} (hG : 0 ≤ G) (hM : 0 < M) (hR : 0 ≤ R) (hQ : 0 < Q) (hQP : Q ≤ Pmin) (hQV : Q ≤ V) (hRV : R ≤ V) : rationalPhaseBlockBound m G M R Q Pmin ≤ (36 * (54 : ℝ) ^ m * G ^ m) * (V ^ (m + 1) / (M ^ (m + 1) * Q ^ (m - 1))) := by have hP : 0 < Pmin := hQ.trans_le hQP have hV : 0 < V := hQ.trans_le hQV have hB : 1 + 2 * Q / Pmin ≤ 3 := by have h := (div_le_one hP).mpr hQP rw [mul_div_assoc] linarith have hN : 2 * Q + R ≤ 3 * V := by linarith unfold rationalPhaseBlockBound calc _ ≤ 12 * (6 * G) ^ m * 3 ^ m * (3 * V) ^ (m + 1) / (M ^ (m + 1) * Q ^ (m - 1)) := by gcongr _ = _ := by rw [show (54 : ℝ) = 6 * 3 * 3 by norm_num] simp only [mul_pow, pow_succ] ring theorem phaseBlock_small_Q_ratio_le {M Q : ℝ} (hM : 1 < M) (hMQ : M ≤ Q) {m : ℕ} (hm : 8 ≤ m) : (M ^ (5 / 4 : ℝ)) ^ (m + 1) / (M ^ (m + 1) * Q ^ (m - 1)) ≤ M ^ (-(m : ℝ) / 2) := by have hM0 : 0 < M := by linarith have hm1 : 1 ≤ m := by omega have hmR : (8 : ℝ) ≤ m := by exact_mod_cast hm calc _ ≤ (M ^ (5 / 4 : ℝ)) ^ (m + 1) / (M ^ (m + 1) * M ^ (m - 1)) := by apply div_le_div_of_nonneg_left (by positivity) (by positivity) exact mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hM0.le hMQ (m - 1)) (by positivity) _ = M ^ ((5 / 4 : ℝ) * ((m : ℝ) + 1) - (((m : ℝ) + 1) + ((m : ℝ) - 1))) := by rw [phaseBlock_power_ratio hM0, Nat.cast_add, Nat.cast_one, Nat.cast_sub hm1, Nat.cast_one] _ ≤ _ := rpow_le_rpow_of_exponent_le hM.le (by linarith) theorem phaseBlock_large_Q_ratio_le {M Q a : ℝ} (hM : 1 < M) (hQ : 0 < Q) (hQa : Q ≤ M ^ a) {m : ℕ} (hm : 8 ≤ m) (hma : 8 * a ≤ (m : ℝ)) : Q ^ (m + 1) / (M ^ (m + 1) * Q ^ (m - 1)) ≤ M ^ (-(m : ℝ) / 2) := by have hM0 : 0 < M := by linarith have hmR : (8 : ℝ) ≤ m := by exact_mod_cast hm rw [phaseBlock_cancel_powers hM0 hQ (by omega)] calc _ ≤ (M ^ a) ^ 2 / M ^ (m + 1) := div_le_div_of_nonneg_right (pow_le_pow_left₀ hQ.le hQa 2) (by positivity) _ = M ^ (2 * a - ((m : ℝ) + 1)) := by rw [← rpow_mul_natCast hM0.le, ← rpow_natCast M (m + 1), ← rpow_sub hM0] congr 1 push_cast ring _ ≤ _ := rpow_le_rpow_of_exponent_le hM.le (by linarith) /-- Middle blocks and the final range below the least prime mark share the decay `M^(-m/2)`. -/ theorem rationalPhaseBlockBound_below_prime_le {m : ℕ} {G M R Q Pmin a : ℝ} (hG : 0 ≤ G) (hM : 1 < M) (hR : 0 ≤ R) (hRscale : R ≤ M ^ (5 / 4 : ℝ)) (hMQ : M ≤ Q) (hQa : Q ≤ M ^ a) (hQP : Q ≤ Pmin) (hm : 8 ≤ m) (hma : 8 * a ≤ (m : ℝ)) : rationalPhaseBlockBound m G M R Q Pmin ≤ (1000 : ℝ) ^ (m + 1) * G ^ m * M ^ (-(m : ℝ) / 2) := by have hM0 : 0 < M := by linarith have hQ : 0 < Q := hM0.trans_le hMQ have hscale : rationalPhaseBlockBound m G M R Q Pmin ≤ (36 * (54 : ℝ) ^ m * G ^ m) * M ^ (-(m : ℝ) / 2) := by rcases le_total Q (M ^ (5 / 4 : ℝ)) with hsmall | hlarge · exact (rationalPhaseBlockBound_le_scale hG hM0 hR hQ hQP hsmall hRscale).trans (mul_le_mul_of_nonneg_left (phaseBlock_small_Q_ratio_le hM hMQ hm) (by positivity)) · exact (rationalPhaseBlockBound_le_scale hG hM0 hR hQ hQP le_rfl (hRscale.trans hlarge)).trans (mul_le_mul_of_nonneg_left (phaseBlock_large_Q_ratio_le hM hQ hQa hm hma) (by positivity)) apply hscale.trans exact mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right (phaseBlock_coefficient_le m (by norm_num : (0 : ℝ) ≤ 54) (by norm_num)) (pow_nonneg hG m)) (rpow_nonneg hM0.le _) /-- Once the denominator exceeds the least mark scale, isolate the ratio `Q/Pmin` that replaces the bounded progression factor. -/ theorem rationalPhaseBlockBound_le_high_ratio {m : ℕ} {G M R Q Pmin : ℝ} (hG : 0 ≤ G) (hM : 0 < M) (hR : 0 ≤ R) (hP : 0 < Pmin) (hPQ : Pmin ≤ Q) (hRP : R ≤ Pmin) (hm : 1 ≤ m) : rationalPhaseBlockBound m G M R Q Pmin ≤ (36 * (54 : ℝ) ^ m * G ^ m) * (Q ^ 2 * (Q / Pmin) ^ m / M ^ (m + 1)) := by have hQ : 0 < Q := hP.trans_le hPQ have hB : 1 + 2 * Q / Pmin ≤ 3 * (Q / Pmin) := by have h := (one_le_div hP).mpr hPQ rw [mul_div_assoc] linarith have hN : 2 * Q + R ≤ 3 * Q := by linarith unfold rationalPhaseBlockBound calc _ ≤ 12 * (6 * G) ^ m * (3 * (Q / Pmin)) ^ m * (3 * Q) ^ (m + 1) / (M ^ (m + 1) * Q ^ (m - 1)) := by gcongr _ = (36 * (54 : ℝ) ^ m * G ^ m) * (Q / Pmin) ^ m * (Q ^ (m + 1) / (M ^ (m + 1) * Q ^ (m - 1))) := by rw [show (54 : ℝ) = 6 * 3 * 3 by norm_num] simp only [mul_pow, pow_succ] ring _ = _ := by rw [phaseBlock_cancel_powers hM hQ hm]; ring theorem phaseBlock_above_prime_ratio_le {M Q Pmin U a : ℝ} (hM : 1 < M) (hQ : 0 < Q) (hP : 0 < Pmin) (hQU : Q ≤ U) (hUa : U ≤ M ^ a) (hPlower : U / (2 * M ^ (1 / 8 : ℝ)) ≤ Pmin) {m : ℕ} (hm : 8 ≤ m) (hma : 8 * a ≤ (m : ℝ)) : Q ^ 2 * (Q / Pmin) ^ m / M ^ (m + 1) ≤ (2 : ℝ) ^ m * M ^ (-(m : ℝ) / 2) := by have hM0 : 0 < M := by linarith have hmR : (8 : ℝ) ≤ m := by exact_mod_cast hm have hratio : Q / Pmin ≤ 2 * M ^ (1 / 8 : ℝ) := by apply (div_le_iff₀ hP).mpr have h := (div_le_iff₀ (show 0 < 2 * M ^ (1 / 8 : ℝ) by positivity)).mp hPlower nlinarith calc _ ≤ (M ^ a) ^ 2 * (2 * M ^ (1 / 8 : ℝ)) ^ m / M ^ (m + 1) := div_le_div_of_nonneg_right (mul_le_mul (pow_le_pow_left₀ hQ.le (hQU.trans hUa) 2) (pow_le_pow_left₀ (div_nonneg hQ.le hP.le) hratio m) (pow_nonneg (div_nonneg hQ.le hP.le) m) (sq_nonneg _)) (by positivity) _ = (2 : ℝ) ^ m * ((M ^ a) ^ 2 * (M ^ (1 / 8 : ℝ)) ^ m / M ^ (m + 1)) := by rw [mul_pow] ring _ = (2 : ℝ) ^ m * M ^ (a * 2 + (1 / 8 : ℝ) * (m : ℝ) - ((m : ℝ) + 1)) := by rw [← rpow_mul_natCast hM0.le, ← rpow_mul_natCast hM0.le, ← rpow_add hM0, ← rpow_natCast M (m + 1), ← rpow_sub hM0] norm_num _ ≤ _ := mul_le_mul_of_nonneg_left (rpow_le_rpow_of_exponent_le hM.le (by linarith)) (by positivity) /-- Large denominators retain the same decay, using the high-prime window's lower endpoint `U/(2M^(1/8))`. -/ theorem rationalPhaseBlockBound_above_prime_le {m : ℕ} {G M R Q Pmin U a : ℝ} (hG : 0 ≤ G) (hM : 1 < M) (hR : 0 ≤ R) (hP : 0 < Pmin) (hPQ : Pmin ≤ Q) (hRP : R ≤ Pmin) (hQU : Q ≤ U) (hUa : U ≤ M ^ a) (hPlower : U / (2 * M ^ (1 / 8 : ℝ)) ≤ Pmin) (hm : 8 ≤ m) (hma : 8 * a ≤ (m : ℝ)) : rationalPhaseBlockBound m G M R Q Pmin ≤ (1000 : ℝ) ^ (m + 1) * G ^ m * M ^ (-(m : ℝ) / 2) := by have hM0 : 0 < M := by linarith have hQ : 0 < Q := hP.trans_le hPQ calc _ ≤ (36 * (54 : ℝ) ^ m * G ^ m) * (Q ^ 2 * (Q / Pmin) ^ m / M ^ (m + 1)) := rationalPhaseBlockBound_le_high_ratio hG hM0 hR hP hPQ hRP (by omega) _ ≤ (36 * (54 : ℝ) ^ m * G ^ m) * ((2 : ℝ) ^ m * M ^ (-(m : ℝ) / 2)) := mul_le_mul_of_nonneg_left (phaseBlock_above_prime_ratio_le hM hQ hP hQU hUa hPlower hm hma) (by positivity) _ = (36 * (108 : ℝ) ^ m * G ^ m) * M ^ (-(m : ℝ) / 2) := by rw [show (108 : ℝ) = 54 * 2 by norm_num, mul_pow] ring _ ≤ _ := mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right (phaseBlock_coefficient_le m (by norm_num : (0 : ℝ) ≤ 108) (by norm_num)) (pow_nonneg hG m)) (rpow_nonneg hM0.le _) end Erdos859Verification end /- Inlined development module: FinitePhaseBlockAssembly.lean -/ section /- Finite assembly of phase errors over a prescribed denominator cover. -/ namespace Erdos859Verification open Finset Real theorem primePhaseArcEvent_mono {m : ℕ} {P : Fin m → Finset ℕ} {F F' : Set (AddCircle (1 : ℝ))} {J J' : Finset ℕ} {U : ℝ} (hF : F ⊆ F') (hJ : J ⊆ J') {x : (i : Fin m) → P i} (hx : primePhaseArcEvent F J U x) : primePhaseArcEvent F' J' U x := by obtain ⟨alpha, halpha, q, hq, a, hcop, harc, hmarks⟩ := hx exact ⟨alpha, hF halpha, q, hJ hq, a, hcop, harc, fun i ↦ hF (hmarks i)⟩ /-- Dirichlet approximation and the weight-one norm bound place each bad phase in the small-denominator set or one member of the fixed finite cover. -/ theorem primeFarPhaseEvent_finite_cover {β : Type*} {m : ℕ} {P : Fin m → Finset ℕ} (F : Set (AddCircle (1 : ℝ))) {Y : ℝ} (hY : 0 < Y) {U : ℕ} (hU : 2 < U) (hF : ∀ alpha ∈ F, ‖alpha‖ ≤ 1 / Y) (Jsmall : Finset ℕ) (blocks : Finset β) (J : β → Finset ℕ) (Fblock : β → Set (AddCircle (1 : ℝ))) (hFblock : ∀ b ∈ blocks, F ⊆ Fblock b) (hcover : ∀ q : ℕ, 2 ≤ q → q ≤ U → Y / 2 < (q : ℝ) → q ∈ Jsmall ∨ ∃ b ∈ blocks, q ∈ J b) {x : (i : Fin m) → P i} (hx : primeFarPhaseEvent F (U : ℝ) x) : primePhaseArcEvent F Jsmall (U : ℝ) x ∨ ∃ b ∈ blocks, primePhaseArcEvent (Fblock b) (J b) (U : ℝ) x := by obtain ⟨alpha, halpha, hfar, hmarks⟩ := hx obtain ⟨q, hq, hqU, a, hcop, harc⟩ := unitCircle_exists_nontrivial_reduced_grid_approx alpha (by omega) hfar have hhalf := reduced_arc_denominator_gt_half hY (by exact_mod_cast hU) hq a hcop (hF alpha halpha) harc rcases hcover q hq hqU hhalf with hsmall | ⟨b, hb, hqb⟩ · exact Or.inl ⟨alpha, halpha, q, hsmall, a, hcop, harc, hmarks⟩ · exact Or.inr ⟨b, hb, alpha, hFblock b hb halpha, q, hqb, a, hcop, harc, fun i ↦ hFblock b hb (hmarks i)⟩ /-- This is a union bound for the actual finite product of mark weights. No independence of the overlapping phase events is asserted. -/ theorem independentPrimeFarPhaseMass_le_finite_arc_cover {β : Type*} {m : ℕ} (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (hw : ∀ i p, p ∈ P i → 0 ≤ weight i p) (F : Set (AddCircle (1 : ℝ))) (U : ℝ) (Jsmall : Finset ℕ) (blocks : Finset β) (J : β → Finset ℕ) (Fblock : β → Set (AddCircle (1 : ℝ))) (hcover : ∀ x : (i : Fin m) → P i, primeFarPhaseEvent F U x → primePhaseArcEvent F Jsmall U x ∨ ∃ b ∈ blocks, primePhaseArcEvent (Fblock b) (J b) U x) : independentPrimeFarPhaseMass P weight F U ≤ independentPrimePhaseArcMass P weight F Jsmall U + ∑ b ∈ blocks, independentPrimePhaseArcMass P weight (Fblock b) (J b) U := by classical let W : ((i : Fin m) → P i) → ℝ := finiteProductWeight (fun i p ↦ weight i p.val) have hW (x : (i : Fin m) → P i) : 0 ≤ W x := finiteProductWeight_nonneg (fun i p ↦ hw i p.val p.property) x let E : β → ((i : Fin m) → P i) → Prop := fun b x ↦ primePhaseArcEvent (Fblock b) (J b) U x have hpoint (x : (i : Fin m) → P i) : W x * (if primeFarPhaseEvent F U x then 1 else 0) ≤ W x * (if primePhaseArcEvent F Jsmall U x then 1 else 0) + W x * (if ∃ b ∈ blocks, E b x then 1 else 0) := by by_cases hx : primeFarPhaseEvent F U x · rcases hcover x hx with hs | hb · rw [if_pos hx, if_pos hs, mul_one] exact le_add_of_nonneg_right (mul_nonneg (hW x) (by split_ifs <;> norm_num)) · have he : ∃ b ∈ blocks, E b x := hb rw [if_pos hx, if_pos he, mul_one] exact le_add_of_nonneg_left (mul_nonneg (hW x) (by split_ifs <;> norm_num)) · rw [if_neg hx, mul_zero] exact add_nonneg (mul_nonneg (hW x) (by split_ifs <;> norm_num)) (mul_nonneg (hW x) (by split_ifs <;> norm_num)) have hsplit : independentPrimeFarPhaseMass P weight F U ≤ independentPrimePhaseArcMass P weight F Jsmall U + ∑ x : (i : Fin m) → P i, W x * (if ∃ b ∈ blocks, E b x then 1 else 0) := by unfold independentPrimeFarPhaseMass independentPrimePhaseArcMass rw [← sum_add_distrib] exact sum_le_sum (fun x _ ↦ hpoint x) apply hsplit.trans apply add_le_add le_rfl exact finite_weighted_union_bound_general univ blocks W (fun x _ ↦ hW x) E theorem independentPrimeFarPhaseMass_denominator_cover_le {β : Type*} {m : ℕ} (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (hw : ∀ i p, p ∈ P i → 0 ≤ weight i p) (F : Set (AddCircle (1 : ℝ))) {Y : ℝ} (hY : 0 < Y) {U : ℕ} (hU : 2 < U) (hF : ∀ alpha ∈ F, ‖alpha‖ ≤ 1 / Y) (Jsmall : Finset ℕ) (blocks : Finset β) (J : β → Finset ℕ) (Fblock : β → Set (AddCircle (1 : ℝ))) (hFblock : ∀ b ∈ blocks, F ⊆ Fblock b) (hcover : ∀ q : ℕ, 2 ≤ q → q ≤ U → Y / 2 < (q : ℝ) → q ∈ Jsmall ∨ ∃ b ∈ blocks, q ∈ J b) : independentPrimeFarPhaseMass P weight F (U : ℝ) ≤ independentPrimePhaseArcMass P weight F Jsmall (U : ℝ) + ∑ b ∈ blocks, independentPrimePhaseArcMass P weight (Fblock b) (J b) (U : ℝ) := independentPrimeFarPhaseMass_le_finite_arc_cover P weight hw F (U : ℝ) Jsmall blocks J Fblock (fun _ hx ↦ primeFarPhaseEvent_finite_cover F hY hU hF Jsmall blocks J Fblock hFblock hcover hx) theorem sum_phase_block_decay_le {β : Type*} (blocks : Finset β) (M : β → ℝ) {M0 G : ℝ} (hM0 : 0 < M0) (hG : 0 ≤ G) (hM : ∀ b ∈ blocks, M0 ≤ M b) (m : ℕ) : (∑ b ∈ blocks, (1000 : ℝ) ^ (m + 1) * G ^ m * M b ^ (-(m : ℝ) / 2)) ≤ (blocks.card : ℝ) * (1000 : ℝ) ^ (m + 1) * G ^ m * M0 ^ (-(m : ℝ) / 2) := by have hexp : -(m : ℝ) / 2 ≤ 0 := div_nonpos_of_nonpos_of_nonneg (neg_nonpos.mpr (Nat.cast_nonneg m)) (by norm_num) calc _ ≤ ∑ _b ∈ blocks, (1000 : ℝ) ^ (m + 1) * G ^ m * M0 ^ (-(m : ℝ) / 2) := sum_le_sum (fun b hb ↦ mul_le_mul_of_nonneg_left (rpow_le_rpow_of_nonpos hM0 (hM b hb) hexp) (by positivity)) _ = _ := by simp; ring /-- Assemble explicit small-denominator and block estimates. The cover is fixed, so only its cardinality enters the common-anchor bound. -/ theorem independentPrimeFarPhaseMass_finite_decay_le {β : Type*} {m : ℕ} (P : Fin m → Finset ℕ) (weight : Fin m → ℕ → ℝ) (hw : ∀ i p, p ∈ P i → 0 ≤ weight i p) (F : Set (AddCircle (1 : ℝ))) {Y : ℝ} (hY : 0 < Y) {U : ℕ} (hU : 2 < U) (hF : ∀ alpha ∈ F, ‖alpha‖ ≤ 1 / Y) (Jsmall : Finset ℕ) (blocks : Finset β) (J : β → Finset ℕ) (Fblock : β → Set (AddCircle (1 : ℝ))) (hFblock : ∀ b ∈ blocks, F ⊆ Fblock b) (hcover : ∀ q : ℕ, 2 ≤ q → q ≤ U → Y / 2 < (q : ℝ) → q ∈ Jsmall ∨ ∃ b ∈ blocks, q ∈ J b) {G Q0 M0 : ℝ} (hG : 0 ≤ G) (hM0 : 0 < M0) (M : β → ℝ) (hM : ∀ b ∈ blocks, M0 ≤ M b) (hsmall : independentPrimePhaseArcMass P weight F Jsmall (U : ℝ) ≤ Q0 ^ 2 * (16 * G / Y) ^ m) (hblock : ∀ b ∈ blocks, independentPrimePhaseArcMass P weight (Fblock b) (J b) (U : ℝ) ≤ (1000 : ℝ) ^ (m + 1) * G ^ m * M b ^ (-(m : ℝ) / 2)) : independentPrimeFarPhaseMass P weight F (U : ℝ) ≤ Q0 ^ 2 * (16 * G / Y) ^ m + (blocks.card : ℝ) * (1000 : ℝ) ^ (m + 1) * G ^ m * M0 ^ (-(m : ℝ) / 2) := by apply (independentPrimeFarPhaseMass_denominator_cover_le P weight hw F hY hU hF Jsmall blocks J Fblock hFblock hcover).trans apply add_le_add hsmall exact (sum_le_sum hblock).trans (sum_phase_block_decay_le blocks M hM0 hG hM m) end Erdos859Verification end /- Inlined development module: PrimeLogQuantileCoupling.lean -/ section /- Exact aggregation of prime log marks and their log-uniform couplings. -/ namespace Erdos859Verification open Finset Real MeasureTheory noncomputable def finiteRealAtomWeight {ι : Type*} (P : Finset ι) (a : ι → ℝ) (f : ι → ℝ) (x : ℝ) : ℝ := ∑ i ∈ P.filter (fun i ↦ f i = x), a i theorem finiteRealAtomWeight_nonneg {ι : Type*} {P : Finset ι} {a : ι → ℝ} (ha : ∀ i ∈ P, 0 ≤ a i) (f : ι → ℝ) (x : ℝ) : 0 ≤ finiteRealAtomWeight P a f x := sum_nonneg (fun i hi ↦ ha i (Finset.mem_filter.mp hi).1) theorem sum_finiteRealAtomWeight {ι : Type*} (P : Finset ι) (a : ι → ℝ) (f : ι → ℝ) : (∑ x ∈ P.image f, finiteRealAtomWeight P a f x) = ∑ i ∈ P, a i := by classical exact sum_fiberwise_of_maps_to (fun i hi ↦ mem_image_of_mem f hi) a theorem finiteRealAtomWeight_cdf {ι : Type*} (P : Finset ι) (a : ι → ℝ) (f : ι → ℝ) (v : ℝ) : finiteMarkCDF (P.image f) (finiteRealAtomWeight P a f) v = ∑ i ∈ P.filter (fun i ↦ f i ≤ v), a i := by classical unfold finiteMarkCDF finiteRealAtomWeight rw [sum_fiberwise_eq_sum_filter] congr 1 ext i simp only [Finset.mem_filter] constructor · exact fun ⟨hi, _, hv⟩ ↦ ⟨hi, hv⟩ · exact fun ⟨hi, hv⟩ ↦ ⟨hi, mem_image_of_mem f hi, hv⟩ noncomputable def finiteIndexedMarkLaw {ι : Type*} (P : Finset ι) (a : ι → ℝ) (f : ι → ℝ) : Measure ℝ := ∑ i ∈ P, ENNReal.ofReal (a i) • Measure.dirac (f i) theorem finiteMarkLaw_aggregate {ι : Type*} {P : Finset ι} {a : ι → ℝ} (ha : ∀ i ∈ P, 0 ≤ a i) (f : ι → ℝ) : finiteMarkLaw (P.image f) (finiteRealAtomWeight P a f) = finiteIndexedMarkLaw P a f := by classical unfold finiteMarkLaw finiteIndexedMarkLaw calc _ = ∑ x ∈ P.image f, ∑ i ∈ P.filter (fun i ↦ f i = x), ENNReal.ofReal (a i) • Measure.dirac (f i) := by apply sum_congr rfl intro x _ rw [finiteRealAtomWeight, ENNReal.ofReal_sum_of_nonneg (fun i hi ↦ ha i (Finset.mem_filter.mp hi).1), sum_smul] apply sum_congr rfl intro i hi rw [(Finset.mem_filter.mp hi).2] _ = _ := sum_fiberwise_of_maps_to (fun i hi ↦ mem_image_of_mem f hi) _ noncomputable def primeLogAtomSet (u w : ℝ) : Finset ℝ := (primeLogWindow u (u + w)).image (fun p : ℕ ↦ log (p : ℝ)) noncomputable def primeLogOddsAtomWeight (lam u w : ℝ) : ℝ → ℝ := finiteRealAtomWeight (primeLogWindow u (u + w)) (primeLogOddsMarkWeight lam u (u + w)) (fun p : ℕ ↦ log (p : ℝ)) noncomputable def primeReciprocalOddsAtomWeight (u w : ℝ) : ℝ → ℝ := finiteRealAtomWeight (primeLogWindow u (u + w)) (primeReciprocalOddsMarkWeight u (u + w)) (fun p : ℕ ↦ log (p : ℝ)) theorem primeLogAtomSet_mem {u w x : ℝ} (hx : x ∈ primeLogAtomSet u w) : x ∈ Set.Icc u (u + w) := by obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hx exact ⟨(mem_primeLogWindow.mp hp).2.1.le, (mem_primeLogWindow.mp hp).2.2⟩ theorem primeLogOddsMark_additive_normalized {lam u w : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) : (∀ p ∈ primeLogWindow u (u + w), 0 ≤ primeLogOddsMarkWeight lam u (u + w) p) ∧ (∑ p ∈ primeLogWindow u (u + w), primeLogOddsMarkWeight lam u (u + w) p) = 1 := by have hu0 : 0 < u := hw.trans_le hwu have hm := (primeNormalizedLogOddsWindowMass_broad_bounds hlam hlam2 hu hw hwu hlarge).1 have hm0 : 0 < primeNormalizedLogOddsWindowMass lam u (u + w) := (by positivity : 0 < w / (4 * u)).trans_le hm have hI : ∀ p ∈ primeLogWindow u (u + w), 0 ≤ primeLogOddsIntensity lam p := by intro p hp exact (by positivity : 0 ≤ 1 / (p : ℝ)).trans (primeLogOddsIntensity_bounds hlam hlam2 (mem_primeLogWindow.mp hp).1).1 constructor · intro p hp exact div_nonneg (hI p hp) (sum_nonneg hI) · rw [← primeNormalizedLogOddsWindowMass_ratio_eq_markSum (v := u + w) (by linarith : 0 < lam)] exact div_self hm0.ne' theorem primeLogOddsAtomWeight_normalized {lam u w : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) : (∀ x ∈ primeLogAtomSet u w, 0 ≤ primeLogOddsAtomWeight lam u w x) ∧ (∑ x ∈ primeLogAtomSet u w, primeLogOddsAtomWeight lam u w x) = 1 := by have h := primeLogOddsMark_additive_normalized hlam hlam2 hu hw hwu hlarge constructor · intro x _ exact finiteRealAtomWeight_nonneg h.1 _ x · exact (sum_finiteRealAtomWeight _ _ _).trans h.2 theorem primeReciprocalOddsAtomWeight_normalized {u w : ℝ} (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) : (∀ x ∈ primeLogAtomSet u w, 0 ≤ primeReciprocalOddsAtomWeight u w x) ∧ (∑ x ∈ primeLogAtomSet u w, primeReciprocalOddsAtomWeight u w x) = 1 := by have h := primeReciprocalOddsMarkWeight_normalized hu hw hwu hlarge constructor · intro x _ exact finiteRealAtomWeight_nonneg (fun p hp ↦ (h.1 p hp).le) _ x · exact (sum_finiteRealAtomWeight _ _ _).trans h.2 theorem primeLogOddsAtomWeight_cdf {lam u w v : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) (hv : v ∈ Set.Icc u (u + w)) : |finiteMarkCDF (primeLogAtomSet u w) (primeLogOddsAtomWeight lam u w) v - log (v / u) / log (1 + w / u)| ≤ 8 * primeLogOddsErrorConstant / w := by rw [primeLogAtomSet, primeLogOddsAtomWeight, finiteRealAtomWeight_cdf] exact primeLogOddsMark_cdf_estimate hlam hlam2 hu hw hwu hlarge hv.1 hv.2 theorem primeReciprocalOddsAtomWeight_cdf {u w v : ℝ} (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) (hv : v ∈ Set.Icc u (u + w)) : |finiteMarkCDF (primeLogAtomSet u w) (primeReciprocalOddsAtomWeight u w) v - log (v / u) / log (1 + w / u)| ≤ 8 * primeLogOddsErrorConstant / w := by rw [primeLogAtomSet, primeReciprocalOddsAtomWeight, finiteRealAtomWeight_cdf] exact primeReciprocalOddsMark_cdf_estimate hu hw hwu hlarge hv.1 hv.2 noncomputable def primeLogOddsLogLaw (lam u w : ℝ) : Measure ℝ := finiteIndexedMarkLaw (primeLogWindow u (u + w)) (primeLogOddsMarkWeight lam u (u + w)) (fun p : ℕ ↦ log (p : ℝ)) noncomputable def primeReciprocalOddsLogLaw (u w : ℝ) : Measure ℝ := finiteIndexedMarkLaw (primeLogWindow u (u + w)) (primeReciprocalOddsMarkWeight u (u + w)) (fun p : ℕ ↦ log (p : ℝ)) noncomputable def primeLogOddsQuantileCoupling (lam u w : ℝ) : Measure (ℝ × ℝ) := finiteQuantileCoupling (primeLogAtomSet u w) (primeLogOddsAtomWeight lam u w) (logUniformQuantile u w) noncomputable def primeReciprocalOddsQuantileCoupling (u w : ℝ) : Measure (ℝ × ℝ) := finiteQuantileCoupling (primeLogAtomSet u w) (primeReciprocalOddsAtomWeight u w) (logUniformQuantile u w) theorem primeLogOddsQuantileCoupling_properties {lam u w : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) : Measure.map Prod.fst (primeLogOddsQuantileCoupling lam u w) = primeLogOddsLogLaw lam u w ∧ Measure.map Prod.snd (primeLogOddsQuantileCoupling lam u w) = translationShiftLaw (logUniformDensity u w) ∧ primeLogOddsQuantileCoupling lam u w {z | |z.1 - z.2| ≤ 16 * primeLogOddsErrorConstant} = 1 := by have hn := primeLogOddsAtomWeight_normalized hlam hlam2 hu hw hwu hlarge have hm := finiteQuantile_logUniform_coupling_marginals hn.1 hn.2 hw hwu refine ⟨?_, hm.2, ?_⟩ · exact hm.1.trans (finiteMarkLaw_aggregate (primeLogOddsMark_additive_normalized hlam hlam2 hu hw hwu hlarge).1 _) · exact finiteQuantile_logUniform_coupling_displacement hn.1 hn.2 hw hwu (fun _ hx ↦ primeLogAtomSet_mem hx) (fun _ hv ↦ primeLogOddsAtomWeight_cdf hlam hlam2 hu hw hwu hlarge hv) theorem primeReciprocalOddsQuantileCoupling_properties {u w : ℝ} (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) : Measure.map Prod.fst (primeReciprocalOddsQuantileCoupling u w) = primeReciprocalOddsLogLaw u w ∧ Measure.map Prod.snd (primeReciprocalOddsQuantileCoupling u w) = translationShiftLaw (logUniformDensity u w) ∧ primeReciprocalOddsQuantileCoupling u w {z | |z.1 - z.2| ≤ 16 * primeLogOddsErrorConstant} = 1 := by have hn := primeReciprocalOddsAtomWeight_normalized hu hw hwu hlarge have hm := finiteQuantile_logUniform_coupling_marginals hn.1 hn.2 hw hwu refine ⟨?_, hm.2, ?_⟩ · exact hm.1.trans (finiteMarkLaw_aggregate (fun p hp ↦ ((primeReciprocalOddsMarkWeight_normalized hu hw hwu hlarge).1 p hp).le) _) · exact finiteQuantile_logUniform_coupling_displacement hn.1 hn.2 hw hwu (fun _ hx ↦ primeLogAtomSet_mem hx) (fun _ hv ↦ primeReciprocalOddsAtomWeight_cdf hu hw hwu hlarge hv) end Erdos859Verification end /- Inlined development module: PrimePairQuantileCoupling.lean -/ section /- Independent prime pairs inherit exact difference laws and bounded displacement from the single-mark quantile coupling. -/ namespace Erdos859Verification open Real MeasureTheory def pairCoupledDifference (z : (ℝ × ℝ) × (ℝ × ℝ)) : ℝ × ℝ := (z.1.1 - z.2.1, z.1.2 - z.2.2) theorem measurable_pairCoupledDifference : Measurable pairCoupledDifference := by unfold pairCoupledDifference fun_prop noncomputable def pairDifferenceCoupling (μ : Measure (ℝ × ℝ)) : Measure (ℝ × ℝ) := Measure.map pairCoupledDifference (μ.prod μ) theorem pairDifferenceCoupling_fst (μ : Measure (ℝ × ℝ)) [SFinite μ] : Measure.map Prod.fst (pairDifferenceCoupling μ) = Measure.map (fun z : ℝ × ℝ ↦ z.1 - z.2) ((Measure.map Prod.fst μ).prod (Measure.map Prod.fst μ)) := by unfold pairDifferenceCoupling rw [Measure.map_map measurable_fst measurable_pairCoupledDifference, Measure.map_prod_map μ μ measurable_fst measurable_fst, Measure.map_map (by fun_prop) (measurable_fst.prodMap measurable_fst)] rfl theorem pairDifferenceCoupling_snd (μ : Measure (ℝ × ℝ)) [SFinite μ] : Measure.map Prod.snd (pairDifferenceCoupling μ) = Measure.map (fun z : ℝ × ℝ ↦ z.1 - z.2) ((Measure.map Prod.snd μ).prod (Measure.map Prod.snd μ)) := by unfold pairDifferenceCoupling rw [Measure.map_map measurable_snd measurable_pairCoupledDifference, Measure.map_prod_map μ μ measurable_snd measurable_snd, Measure.map_map (by fun_prop) (measurable_snd.prodMap measurable_snd)] rfl theorem pairDifferenceCoupling_displacement (μ : Measure (ℝ × ℝ)) [IsProbabilityMeasure μ] {r : ℝ} (hr : μ {z | |z.1 - z.2| ≤ r} = 1) : pairDifferenceCoupling μ {z | |z.1 - z.2| ≤ 2 * r} = 1 := by have hm : MeasurableSet {z : ℝ × ℝ | |z.1 - z.2| ≤ 2 * r} := by measurability rw [pairDifferenceCoupling, Measure.map_apply measurable_pairCoupledDifference hm] apply le_antisymm prob_le_one have hg : μ.prod μ ({z : ℝ × ℝ | |z.1 - z.2| ≤ r} ×ˢ {z : ℝ × ℝ | |z.1 - z.2| ≤ r}) = 1 := by rw [Measure.prod_prod, hr, one_mul] rw [← hg] apply measure_mono intro z hz change |(z.1.1 - z.2.1) - (z.1.2 - z.2.2)| ≤ 2 * r have hid : (z.1.1 - z.2.1) - (z.1.2 - z.2.2) = (z.1.1 - z.1.2) - (z.2.1 - z.2.2) := by ring rw [hid] have hz1 : |z.1.1 - z.1.2| ≤ r := hz.1 have hz2 : |z.2.1 - z.2.2| ≤ r := hz.2 exact (abs_sub _ _).trans (by linarith) theorem finiteQuantileCoupling_isProbability (P : Finset ℝ) (a : ℝ → ℝ) {Q : ℝ → ℝ} (hQ : Measurable Q) : IsProbabilityMeasure (finiteQuantileCoupling P a Q) := by let : IsProbabilityMeasure (volume.restrict (Set.Ioc (0 : ℝ) 1)) := finiteQuantile_uniform_isProbability exact Measure.isProbabilityMeasure_map ((measurable_finiteQuantile P a).prodMk hQ).aemeasurable noncomputable def primeLogOddsPairQuantileCoupling (lam u w : ℝ) : Measure (ℝ × ℝ) := pairDifferenceCoupling (primeLogOddsQuantileCoupling lam u w) noncomputable def primeReciprocalOddsPairQuantileCoupling (u w : ℝ) : Measure (ℝ × ℝ) := pairDifferenceCoupling (primeReciprocalOddsQuantileCoupling u w) theorem primeLogOddsPairQuantileCoupling_properties {lam u w : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) : Measure.map Prod.fst (primeLogOddsPairQuantileCoupling lam u w) = Measure.map (fun z : ℝ × ℝ ↦ z.1 - z.2) ((primeLogOddsLogLaw lam u w).prod (primeLogOddsLogLaw lam u w)) ∧ Measure.map Prod.snd (primeLogOddsPairQuantileCoupling lam u w) = translationShiftLaw (logUniformPairDensity u w) ∧ primeLogOddsPairQuantileCoupling lam u w {z | |z.1 - z.2| ≤ 32 * primeLogOddsErrorConstant} = 1 := by let : IsProbabilityMeasure (primeLogOddsQuantileCoupling lam u w) := finiteQuantileCoupling_isProbability _ _ (measurable_logUniformQuantile u w) have h := primeLogOddsQuantileCoupling_properties hlam hlam2 hu hw hwu hlarge constructor · rw [primeLogOddsPairQuantileCoupling, pairDifferenceCoupling_fst, h.1] · constructor · rw [primeLogOddsPairQuantileCoupling, pairDifferenceCoupling_snd, h.2.1, logUniformPairDensity_map_eq hw hwu] · have hb := pairDifferenceCoupling_displacement _ h.2.2 simpa only [primeLogOddsPairQuantileCoupling, show 2 * (16 * primeLogOddsErrorConstant) = 32 * primeLogOddsErrorConstant by ring] using hb theorem primeReciprocalOddsPairQuantileCoupling_properties {u w : ℝ} (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) : Measure.map Prod.fst (primeReciprocalOddsPairQuantileCoupling u w) = Measure.map (fun z : ℝ × ℝ ↦ z.1 - z.2) ((primeReciprocalOddsLogLaw u w).prod (primeReciprocalOddsLogLaw u w)) ∧ Measure.map Prod.snd (primeReciprocalOddsPairQuantileCoupling u w) = translationShiftLaw (logUniformPairDensity u w) ∧ primeReciprocalOddsPairQuantileCoupling u w {z | |z.1 - z.2| ≤ 32 * primeLogOddsErrorConstant} = 1 := by let : IsProbabilityMeasure (primeReciprocalOddsQuantileCoupling u w) := finiteQuantileCoupling_isProbability _ _ (measurable_logUniformQuantile u w) have h := primeReciprocalOddsQuantileCoupling_properties hu hw hwu hlarge constructor · rw [primeReciprocalOddsPairQuantileCoupling, pairDifferenceCoupling_fst, h.1] · constructor · rw [primeReciprocalOddsPairQuantileCoupling, pairDifferenceCoupling_snd, h.2.1, logUniformPairDensity_map_eq hw hwu] · have hb := pairDifferenceCoupling_displacement _ h.2.2 simpa only [primeReciprocalOddsPairQuantileCoupling, show 2 * (16 * primeLogOddsErrorConstant) = 32 * primeLogOddsErrorConstant by ring] using hb end Erdos859Verification end /- Inlined development module: PairTranslationStability.lean -/ section /- Deterministic stability of finite translated supports under coupled shifts. -/ namespace Erdos859Verification open Finset Real MeasureTheory open scoped ENNReal theorem abs_subset_sum_sub_le {ι : Type*} {P S : Finset ι} {x y : ι → ℝ} {e : ℝ} (hSP : S ⊆ P) (he : 0 ≤ e) (hxy : ∀ i ∈ P, |y i - x i| ≤ e) : |(∑ i ∈ S, x i) - ∑ i ∈ S, y i| ≤ (P.card : ℝ) * e := by rw [← sum_sub_distrib] calc _ ≤ ∑ i ∈ S, |x i - y i| := abs_sum_le_sum_abs _ _ _ ≤ ∑ _i ∈ S, e := sum_le_sum (fun i hi ↦ by rw [abs_sub_comm]; exact hxy i (hSP hi)) _ = (S.card : ℝ) * e := by simp _ ≤ _ := mul_le_mul_of_nonneg_right (by exact_mod_cast card_le_card hSP) he theorem abs_fin_subset_sum_sub_le {n : ℕ} {x y : Fin n → ℝ} {e : ℝ} (he : 0 ≤ e) (hxy : ∀ i, |y i - x i| ≤ e) (S : Finset (Fin n)) : |(∑ i ∈ S, x i) - ∑ i ∈ S, y i| ≤ (n : ℝ) * e := by simpa only [card_univ, Fintype.card_fin] using abs_subset_sum_sub_le (P := univ) (subset_univ S) he (fun i _ ↦ hxy i) noncomputable def finiteSubsetTranslateSupport {ι : Type*} (A : Set ℝ) (P : Finset ι) (x : ι → ℝ) : Set ℝ := ⋃ S : P.powerset, realTranslateSet A (∑ i ∈ (S : Finset ι), x i) theorem mem_finiteSubsetTranslateSupport {ι : Type*} {A : Set ℝ} {P : Finset ι} {x : ι → ℝ} {z : ℝ} : z ∈ finiteSubsetTranslateSupport A P x ↔ ∃ S : Finset ι, S ⊆ P ∧ z - (∑ i ∈ S, x i) ∈ A := by constructor · intro hz obtain ⟨S, hS⟩ := Set.mem_iUnion.mp hz exact ⟨S.val, mem_powerset.mp S.property, hS⟩ · rintro ⟨S, hS, hz⟩ exact Set.mem_iUnion.mpr ⟨⟨S, mem_powerset.mpr hS⟩, hz⟩ theorem measurableSet_finiteSubsetTranslateSupport {ι : Type*} {A : Set ℝ} (hA : MeasurableSet A) (P : Finset ι) (x : ι → ℝ) : MeasurableSet (finiteSubsetTranslateSupport A P x) := MeasurableSet.iUnion (fun _ ↦ measurableSet_realTranslateSet hA _) def realSupportThickening (A : Set ℝ) (d : ℝ) : Set ℝ := {z | ∃ a ∈ A, |z - a| ≤ d} theorem realSupportThickening_zero (A : Set ℝ) : realSupportThickening A 0 = A := by ext z constructor · rintro ⟨a, ha, hza⟩ have heq : z = a := sub_eq_zero.mp (abs_nonpos_iff.mp hza) simpa only [heq] using ha · intro hz exact ⟨z, hz, by simp⟩ theorem isCompact_realSupportThickening {A : Set ℝ} (hA : IsCompact A) (d : ℝ) : IsCompact (realSupportThickening A d) := by have hi : realSupportThickening A d = (fun q : ℝ × ℝ ↦ q.1 + q.2) '' (A ×ˢ Set.Icc (-d) d) := by ext z constructor · rintro ⟨a, ha, hza⟩ refine ⟨(a, z - a), ⟨ha, ?_⟩, by simp⟩ exact abs_le.mp hza · rintro ⟨⟨a, b⟩, ⟨ha, hb⟩, rfl⟩ exact ⟨a, ha, by simpa only [add_sub_cancel_left] using abs_le.mpr hb⟩ rw [hi] exact (hA.prod isCompact_Icc).image (by fun_prop) theorem measurableSet_realSupportThickening {A : Set ℝ} (hA : IsCompact A) (d : ℝ) : MeasurableSet (realSupportThickening A d) := (isCompact_realSupportThickening hA d).measurableSet noncomputable def finiteThickenedTranslateSupport {ι : Type*} (A : Set ℝ) (P : Finset ι) (x : ι → ℝ) (d : ℝ) : Set ℝ := finiteSubsetTranslateSupport (realSupportThickening A d) P x theorem mem_finiteThickenedTranslateSupport {ι : Type*} {A : Set ℝ} {P : Finset ι} {x : ι → ℝ} {d z : ℝ} : z ∈ finiteThickenedTranslateSupport A P x d ↔ ∃ S : Finset ι, S ⊆ P ∧ ∃ a ∈ A, |z - a - (∑ i ∈ S, x i)| ≤ d := by rw [finiteThickenedTranslateSupport, mem_finiteSubsetTranslateSupport] constructor · rintro ⟨S, hS, a, ha, hdist⟩ refine ⟨S, hS, a, ha, ?_⟩ have hid : z - a - (∑ i ∈ S, x i) = z - (∑ i ∈ S, x i) - a := by ring rw [hid] exact hdist · rintro ⟨S, hS, a, ha, hdist⟩ refine ⟨S, hS, a, ha, ?_⟩ have hid : z - (∑ i ∈ S, x i) - a = z - a - (∑ i ∈ S, x i) := by ring rw [hid] exact hdist theorem measurableSet_finiteThickenedTranslateSupport {ι : Type*} {A : Set ℝ} (hA : IsCompact A) (P : Finset ι) (x : ι → ℝ) (d : ℝ) : MeasurableSet (finiteThickenedTranslateSupport A P x d) := measurableSet_finiteSubsetTranslateSupport (measurableSet_realSupportThickening hA d) P x theorem finiteThickenedTranslateSupport_stability {ι : Type*} {A : Set ℝ} {P : Finset ι} {x y : ι → ℝ} {e d : ℝ} (he : 0 ≤ e) (hxy : ∀ i ∈ P, |y i - x i| ≤ e) : finiteThickenedTranslateSupport A P x d ⊆ finiteThickenedTranslateSupport A P y (d + (P.card : ℝ) * e) := by intro z hz obtain ⟨S, hS, a, ha, hdist⟩ := mem_finiteThickenedTranslateSupport.mp hz refine mem_finiteThickenedTranslateSupport.mpr ⟨S, hS, a, ha, ?_⟩ have hsum := abs_subset_sum_sub_le hS he hxy have hid : z - a - (∑ i ∈ S, y i) = (z - a - (∑ i ∈ S, x i)) + ((∑ i ∈ S, x i) - (∑ i ∈ S, y i)) := by ring rw [hid] exact (abs_add_le _ _).trans (add_le_add hdist hsum) theorem finiteThickenedTranslateSupport_missing_mono {ι : Type*} {A I : Set ℝ} {P : Finset ι} {x y : ι → ℝ} {e d : ℝ} (he : 0 ≤ e) (hxy : ∀ i ∈ P, |y i - x i| ≤ e) (hI : volume I ≠ ∞) : volume.real (I \ finiteThickenedTranslateSupport A P y (d + (P.card : ℝ) * e)) ≤ volume.real (I \ finiteThickenedTranslateSupport A P x d) := by apply measureReal_mono _ (measure_ne_top_of_subset Set.sdiff_subset hI) exact Set.sdiff_subset_sdiff_right (finiteThickenedTranslateSupport_stability he hxy) theorem finThickenedTranslateSupport_stability {n : ℕ} {A : Set ℝ} {x y : Fin n → ℝ} {e d : ℝ} (he : 0 ≤ e) (hxy : ∀ i, |y i - x i| ≤ e) : finiteThickenedTranslateSupport A univ x d ⊆ finiteThickenedTranslateSupport A univ y (d + (n : ℝ) * e) := by simpa only [card_univ, Fintype.card_fin] using finiteThickenedTranslateSupport_stability (A := A) (P := univ) (d := d) he (fun i _ ↦ hxy i) theorem finThickenedTranslateSupport_missing_Icc {n : ℕ} {A : Set ℝ} {x y : Fin n → ℝ} {e d a b : ℝ} (he : 0 ≤ e) (hxy : ∀ i, |y i - x i| ≤ e) : volume.real (Set.Icc a b \ finiteThickenedTranslateSupport A univ y (d + (n : ℝ) * e)) ≤ volume.real (Set.Icc a b \ finiteThickenedTranslateSupport A univ x d) := by simpa only [card_univ, Fintype.card_fin] using finiteThickenedTranslateSupport_missing_mono (A := A) (I := Set.Icc a b) (P := univ) (d := d) he (fun i _ ↦ hxy i) isCompact_Icc.measure_ne_top theorem finiteThickenedTranslateSupport_pair_error {n : ℕ} {A : Set ℝ} {x y : Fin n → ℝ} {d : ℝ} (hxy : ∀ i, |y i - x i| ≤ 32 * primeLogOddsErrorConstant) : finiteThickenedTranslateSupport A univ x d ⊆ finiteThickenedTranslateSupport A univ y (d + 32 * primeLogOddsErrorConstant * n) := by have hC := primeLogOddsErrorConstant_pos have h := finThickenedTranslateSupport_stability (A := A) (d := d) (by positivity) hxy convert h using 1 congr 1 ring noncomputable def finiteBitTranslateSupport {n : ℕ} (A : Set ℝ) (x : Fin n → ℝ) : Set ℝ := ⋃ b : Fin n → Bool, realTranslateSet A (∑ i, if b i then x i else 0) theorem finiteBitTranslateSupport_eq_subsetSupport {n : ℕ} (A : Set ℝ) (x : Fin n → ℝ) : finiteBitTranslateSupport A x = finiteSubsetTranslateSupport A univ x := by classical ext z constructor · intro hz obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hz refine mem_finiteSubsetTranslateSupport.mpr ⟨univ.filter (fun i ↦ b i), filter_subset _ _, ?_⟩ change z - (∑ i, if b i then x i else 0) ∈ A at hb simpa only [sum_filter] using hb · intro hz obtain ⟨S, _, hS⟩ := mem_finiteSubsetTranslateSupport.mp hz apply Set.mem_iUnion.mpr refine ⟨fun i ↦ decide (i ∈ S), ?_⟩ change z - (∑ i : Fin n, if decide (i ∈ S) then x i else 0) ∈ A have hs : (∑ i : Fin n, if decide (i ∈ S) then x i else 0) = ∑ i ∈ S, x i := by simp only [decide_eq_true_eq] rw [← sum_filter] simp rwa [hs] theorem finiteBitTranslateSupport_zero (A : Set ℝ) (x : Fin 0 → ℝ) : finiteBitTranslateSupport A x = A := by ext z constructor · intro hz obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hz simpa only [realTranslateSet, Fin.sum_univ_zero, sub_zero, Set.mem_preimage] using hb · intro hz refine Set.mem_iUnion.mpr ⟨fun _ ↦ false, ?_⟩ simpa only [realTranslateSet, Fin.sum_univ_zero, sub_zero, Set.mem_preimage] using hz theorem finiteBitTranslateSupport_snoc {n : ℕ} (A : Set ℝ) (x : Fin n → ℝ) (g : ℝ) : finiteBitTranslateSupport A (Fin.snoc x g) = finiteBitTranslateSupport A x ∪ realTranslateSet (finiteBitTranslateSupport A x) g := by classical have hsum (b : Fin (n + 1) → Bool) : (∑ i : Fin (n + 1), if b i then Fin.snoc x g i else 0) = (∑ i : Fin n, if b i.castSucc then x i else 0) + if b (Fin.last n) then g else 0 := by rw [Fin.sum_univ_castSucc] simp only [Fin.snoc_castSucc, Fin.snoc_last] ext z constructor · intro hz obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hz change z - (∑ i, if b i then Fin.snoc x g i else 0) ∈ A at hb rw [hsum b] at hb cases hl : b (Fin.last n) · apply Or.inl apply Set.mem_iUnion.mpr refine ⟨fun i ↦ b i.castSucc, ?_⟩ change z - (∑ i : Fin n, if b i.castSucc then x i else 0) ∈ A simpa only [hl, Bool.false_eq_true, if_false, add_zero] using hb · apply Or.inr change z - g ∈ finiteBitTranslateSupport A x apply Set.mem_iUnion.mpr refine ⟨fun i ↦ b i.castSucc, ?_⟩ change z - g - (∑ i : Fin n, if b i.castSucc then x i else 0) ∈ A have hid : z - g - (∑ i : Fin n, if b i.castSucc then x i else 0) = z - ((∑ i : Fin n, if b i.castSucc then x i else 0) + g) := by ring rw [hid] simpa only [hl, if_true] using hb · rintro (hz | hz) · obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hz apply Set.mem_iUnion.mpr refine ⟨Fin.snoc b false, ?_⟩ change z - _ ∈ A rw [hsum] change z - (∑ i : Fin n, if b i then x i else 0) ∈ A at hb simpa only [Fin.snoc_castSucc, Fin.snoc_last, Bool.false_eq_true, if_false, add_zero] using hb · change z - g ∈ finiteBitTranslateSupport A x at hz obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hz apply Set.mem_iUnion.mpr refine ⟨Fin.snoc b true, ?_⟩ change z - _ ∈ A rw [hsum] simp only [Fin.snoc_castSucc, Fin.snoc_last, if_true] have hid : z - ((∑ i, if b i then x i else 0) + g) = z - g - (∑ i, if b i then x i else 0) := by ring rw [hid] exact hb /-- An existing quadratic-refinement certificate retains a finite shift tuple whose complete subset-translation support is the certified set. -/ theorem QuadraticHoleRefinement.exists_shift_tuple {ell : ℝ} {A S : Set ℝ} {n : ℕ} (h : QuadraticHoleRefinement ell A n S) : ∃ x : Fin n → ℝ, S = finiteSubsetTranslateSupport A univ x := by induction h with | initial => refine ⟨fun i ↦ Fin.elim0 i, ?_⟩ rw [← finiteBitTranslateSupport_eq_subsetSupport, finiteBitTranslateSupport_zero] | step _ g _ ih => obtain ⟨x, hx⟩ := ih refine ⟨Fin.snoc x g, ?_⟩ rw [← finiteBitTranslateSupport_eq_subsetSupport, finiteBitTranslateSupport_snoc, finiteBitTranslateSupport_eq_subsetSupport, ← hx] theorem QuadraticHoleRefinement.coupled_missing_transfer {ell : ℝ} {A S : Set ℝ} {n : ℕ} (h : QuadraticHoleRefinement ell A n S) : ∃ x : Fin n → ℝ, S = finiteSubsetTranslateSupport A univ x ∧ ∀ (y : Fin n → ℝ) (e : ℝ), 0 ≤ e → (∀ i, |y i - x i| ≤ e) → ∀ a b : ℝ, volume.real (Set.Icc a b \ finiteThickenedTranslateSupport A univ y ((n : ℝ) * e)) ≤ volume.real (Set.Icc a b \ S) := by obtain ⟨x, hx⟩ := h.exists_shift_tuple refine ⟨x, hx, ?_⟩ intro y e he hxy a b have hb := finThickenedTranslateSupport_missing_Icc (A := A) (d := 0) (a := a) (b := b) he hxy simpa only [zero_add, finiteThickenedTranslateSupport, realSupportThickening_zero, ← hx] using hb theorem finiteSubsetTranslateSupport_base_subset {ι : Type*} (A : Set ℝ) (P : Finset ι) (x : ι → ℝ) : A ⊆ finiteSubsetTranslateSupport A P x := by intro z hz refine mem_finiteSubsetTranslateSupport.mpr ⟨∅, empty_subset P, ?_⟩ simpa only [sum_empty, sub_zero] using hz /-- Initial coverage only uses individual translates. The full subset cube contains all of them, so its missing measure can only be smaller. -/ theorem InitialCoverageByTranslates.exists_shift_tuple_subset {L : ℝ} {B A : Set ℝ} {n : ℕ} (h : InitialCoverageByTranslates L B n A) : ∃ x : Fin n → ℝ, A ⊆ finiteSubsetTranslateSupport B univ x := by induction h with | initial => refine ⟨fun i ↦ Fin.elim0 i, ?_⟩ exact finiteSubsetTranslateSupport_base_subset _ _ _ | step _ g _ ih => obtain ⟨x, hx⟩ := ih refine ⟨Fin.snoc x g, ?_⟩ rw [← finiteBitTranslateSupport_eq_subsetSupport, finiteBitTranslateSupport_snoc, finiteBitTranslateSupport_eq_subsetSupport] intro z hz rcases hz with hz | hz · exact Or.inl (hx hz) · exact Or.inr (finiteSubsetTranslateSupport_base_subset B univ x hz) theorem InitialCoverageByTranslates.coupled_missing_transfer {L : ℝ} {B A : Set ℝ} {n : ℕ} (h : InitialCoverageByTranslates L B n A) : ∃ x : Fin n → ℝ, A ⊆ finiteSubsetTranslateSupport B univ x ∧ ∀ (y : Fin n → ℝ) (e : ℝ), 0 ≤ e → (∀ i, |y i - x i| ≤ e) → ∀ a b : ℝ, volume.real (Set.Icc a b \ finiteThickenedTranslateSupport B univ y ((n : ℝ) * e)) ≤ volume.real (Set.Icc a b \ A) := by obtain ⟨x, hx⟩ := h.exists_shift_tuple_subset refine ⟨x, hx, ?_⟩ intro y e he hxy a b have hb := finThickenedTranslateSupport_missing_Icc (A := B) (d := 0) (a := a) (b := b) he hxy have hb' : volume.real (Set.Icc a b \ finiteThickenedTranslateSupport B univ y ((n : ℝ) * e)) ≤ volume.real (Set.Icc a b \ finiteSubsetTranslateSupport B univ x) := by simpa only [zero_add, finiteThickenedTranslateSupport, realSupportThickening_zero] using hb apply hb'.trans apply measureReal_mono _ (measure_ne_top_of_subset Set.sdiff_subset isCompact_Icc.measure_ne_top) exact Set.sdiff_subset_sdiff_right hx end Erdos859Verification end /- Inlined development module: DivisorStarStructure.lean -/ section /- Distinct actual divisors underlying the indexed divisor star. -/ namespace Erdos859Verification open Finset abbrev DivisorStarCoordinate (n : ℕ) (P : Finset ℕ) := ↥n.divisors ⊕ (↥P × ↥n.divisors) def divisorStarWeight (n : ℕ) (P : Finset ℕ) : DivisorStarCoordinate n P → ℕ | .inl d => d.val | .inr pd => pd.1.val * pd.2.val noncomputable def divisorStar (n : ℕ) (P : Finset ℕ) : Finset ℕ := univ.image (divisorStarWeight n P) theorem divisorStarWeight_pos {n : ℕ} {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (i : DivisorStarCoordinate n P) : 0 < divisorStarWeight n P i := by cases i with | inl d => exact Nat.pos_of_mem_divisors d.property | inr pd => exact Nat.mul_pos (hP pd.1.val pd.1.property).pos (Nat.pos_of_mem_divisors pd.2.property) theorem divisorStarWeight_dvd (n : ℕ) (P : Finset ℕ) (i : DivisorStarCoordinate n P) : divisorStarWeight n P i ∣ n * ∏ p ∈ P, p := by cases i with | inl d => exact dvd_mul_of_dvd_left (Nat.mem_divisors.mp d.property).1 _ | inr pd => have hp : pd.1.val ∣ ∏ p ∈ P, p := dvd_prod_of_mem id pd.1.property have hd : pd.2.val ∣ n := (Nat.mem_divisors.mp pd.2.property).1 simpa only [divisorStarWeight, Nat.mul_comm] using Nat.mul_dvd_mul hp hd theorem divisorStarWeight_injective {n : ℕ} {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hfresh : ∀ p ∈ P, ¬ p ∣ n) : Function.Injective (divisorStarWeight n P) := by intro i j hij have hnot (p : P) (d : n.divisors) : ¬ p.val ∣ d.val := fun h ↦ hfresh p.val p.property (h.trans (Nat.mem_divisors.mp d.property).1) cases i with | inl d => cases j with | inl e => exact congrArg Sum.inl (Subtype.ext hij) | inr pe => change d.val = pe.1.val * pe.2.val at hij exact False.elim (hnot pe.1 d (hij.symm ▸ dvd_mul_right pe.1.val pe.2.val)) | inr pd => cases j with | inl e => change pd.1.val * pd.2.val = e.val at hij exact False.elim (hnot pd.1 e (hij ▸ dvd_mul_right pd.1.val pd.2.val)) | inr qe => change pd.1.val * pd.2.val = qe.1.val * qe.2.val at hij have hpdiv : pd.1.val ∣ qe.1.val * qe.2.val := hij ▸ dvd_mul_right pd.1.val pd.2.val have hpq : pd.1.val = qe.1.val := by rcases (hP pd.1.val pd.1.property).dvd_mul.mp hpdiv with hpq | hpe · exact (Nat.prime_dvd_prime_iff_eq (hP pd.1.val pd.1.property) (hP qe.1.val qe.1.property)).mp hpq · exact False.elim (hnot pd.1 qe.2 hpe) have hde : pd.2.val = qe.2.val := by rw [← hpq] at hij exact Nat.eq_of_mul_eq_mul_left (hP pd.1.val pd.1.property).pos hij exact congrArg Sum.inr (Prod.ext (Subtype.ext hpq) (Subtype.ext hde)) theorem card_divisorStarCoordinate (n : ℕ) (P : Finset ℕ) : Fintype.card (DivisorStarCoordinate n P) = (P.card + 1) * n.divisors.card := by simp only [DivisorStarCoordinate, Fintype.card_sum, Fintype.card_prod, Fintype.card_coe] ring theorem sum_divisorStarWeight (n : ℕ) (P : Finset ℕ) : (∑ i : DivisorStarCoordinate n P, divisorStarWeight n P i) = (1 + ∑ p ∈ P, p) * ∑ d ∈ n.divisors, d := by simp only [DivisorStarCoordinate, Fintype.sum_sum_type, Fintype.sum_prod_type, divisorStarWeight, ← mul_sum] rw [← sum_mul, sum_coe_sort n.divisors (fun d : ℕ ↦ d), sum_coe_sort P (fun p : ℕ ↦ p)] ring theorem mem_divisorStar {n d : ℕ} {P : Finset ℕ} : d ∈ divisorStar n P ↔ d ∈ n.divisors ∨ ∃ p ∈ P, ∃ e ∈ n.divisors, d = p * e := by classical constructor · intro hd obtain ⟨i, _, rfl⟩ := mem_image.mp hd cases i with | inl e => exact Or.inl e.property | inr pe => exact Or.inr ⟨pe.1.val, pe.1.property, pe.2.val, pe.2.property, rfl⟩ · intro hd rcases hd with hd | ⟨p, hp, e, he, rfl⟩ · exact mem_image.mpr ⟨.inl ⟨d, hd⟩, mem_univ _, rfl⟩ · exact mem_image.mpr ⟨.inr (⟨p, hp⟩, ⟨e, he⟩), mem_univ _, rfl⟩ theorem divisors_subset_divisorStar (n : ℕ) (P : Finset ℕ) : n.divisors ⊆ divisorStar n P := fun _ hd ↦ mem_divisorStar.mpr (Or.inl hd) theorem divisorStar_pos {n d : ℕ} {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hd : d ∈ divisorStar n P) : 0 < d := by obtain ⟨i, _, rfl⟩ := mem_image.mp hd exact divisorStarWeight_pos hP i theorem divisorStar_subset_divisors {n : ℕ} {P : Finset ℕ} (hn : 0 < n) (hP : ∀ p ∈ P, p.Prime) : divisorStar n P ⊆ (n * ∏ p ∈ P, p).divisors := by intro d hd obtain ⟨i, _, rfl⟩ := mem_image.mp hd exact Nat.mem_divisors.mpr ⟨divisorStarWeight_dvd n P i, Nat.ne_of_gt (Nat.mul_pos hn (prod_pos (fun p hp ↦ (hP p hp).pos)))⟩ theorem card_divisorStar {n : ℕ} {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hfresh : ∀ p ∈ P, ¬ p ∣ n) : (divisorStar n P).card = (P.card + 1) * n.divisors.card := by rw [divisorStar, card_image_of_injective _ (divisorStarWeight_injective hP hfresh), card_univ] exact card_divisorStarCoordinate n P theorem sum_divisorStar {n : ℕ} {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hfresh : ∀ p ∈ P, ¬ p ∣ n) : (∑ d ∈ divisorStar n P, d) = (1 + ∑ p ∈ P, p) * ∑ d ∈ n.divisors, d := by rw [divisorStar, sum_image] · exact sum_divisorStarWeight n P · exact fun _ _ _ _ h ↦ divisorStarWeight_injective hP hfresh h theorem cubePhaseSquare_divisorStar_eq {n : ℕ} {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hfresh : ∀ p ∈ P, ¬ p ∣ n) (x : AddCircle (1 : ℝ)) : cubePhaseSquare (divisorStarWeight n P) x = ∑ d ∈ divisorStar n P, ‖d • x‖ ^ 2 := by rw [divisorStar, sum_image] · rfl · exact fun _ _ _ _ h ↦ divisorStarWeight_injective hP hfresh h theorem cubePhaseSquare_divisorStar_decomposition (n : ℕ) (P : Finset ℕ) (x : AddCircle (1 : ℝ)) : cubePhaseSquare (divisorStarWeight n P) x = cubePhaseSquare (fun d : n.divisors ↦ d.val) x + ∑ p ∈ P, cubePhaseSquare (fun d : n.divisors ↦ d.val) (p • x) := by unfold cubePhaseSquare simp only [DivisorStarCoordinate, Fintype.sum_sum_type, Fintype.sum_prod_type, divisorStarWeight] apply congrArg (fun z : ℝ ↦ (∑ d : n.divisors, ‖d.val • x‖ ^ 2) + z) rw [sum_coe_sort P (fun p : ℕ ↦ ∑ d : n.divisors, ‖(p * d.val) • x‖ ^ 2)] apply sum_congr rfl intro p _ apply sum_congr rfl intro d _ rw [mul_nsmul] theorem cubePhaseSquare_divisorStar_old_le (n : ℕ) (P : Finset ℕ) (x : AddCircle (1 : ℝ)) : cubePhaseSquare (fun d : n.divisors ↦ d.val) x ≤ cubePhaseSquare (divisorStarWeight n P) x := by rw [cubePhaseSquare_divisorStar_decomposition] exact le_add_of_nonneg_right (sum_nonneg (fun _ _ ↦ cubePhaseSquare_nonneg _ _)) theorem cubePhaseSquare_divisorStar_mark_le (n : ℕ) (P : Finset ℕ) {p : ℕ} (hp : p ∈ P) (x : AddCircle (1 : ℝ)) : cubePhaseSquare (fun d : n.divisors ↦ d.val) (p • x) ≤ cubePhaseSquare (divisorStarWeight n P) x := by rw [cubePhaseSquare_divisorStar_decomposition] exact (single_le_sum (fun q _ ↦ cubePhaseSquare_nonneg (fun d : n.divisors ↦ d.val) (q • x)) hp).trans (le_add_of_nonneg_left (cubePhaseSquare_nonneg _ _)) theorem cubePhaseSquare_comp_injective_le {ι κ : Type*} [Fintype ι] [Fintype κ] (w : κ → ℕ) (f : ι → κ) (hf : Function.Injective f) (x : AddCircle (1 : ℝ)) : cubePhaseSquare (fun i ↦ w (f i)) x ≤ cubePhaseSquare w x := by classical unfold cubePhaseSquare have heq : (∑ i, ‖w (f i) • x‖ ^ 2) = ∑ j ∈ univ.image f, ‖w j • x‖ ^ 2 := by rw [sum_image] exact fun _ _ _ _ h ↦ hf h rw [heq] exact sum_le_sum_of_subset_of_nonneg (subset_univ _) (fun _ _ _ ↦ sq_nonneg _) /-- Any distinct divisor vector from an earlier core embeds in the star. -/ theorem cubePhaseSquare_le_divisorStar_of_injective_dvd {ι : Type*} [Fintype ι] {n : ℕ} (hn : 0 < n) (P : Finset ℕ) (w : ι → ℕ) (hw : Function.Injective w) (hdvd : ∀ i, w i ∣ n) (x : AddCircle (1 : ℝ)) : cubePhaseSquare w x ≤ cubePhaseSquare (divisorStarWeight n P) x := by let f : ι → DivisorStarCoordinate n P := fun i ↦ .inl ⟨w i, Nat.mem_divisors.mpr ⟨hdvd i, Nat.ne_of_gt hn⟩⟩ have hf : Function.Injective f := by intro i j hij apply hw exact congrArg (divisorStarWeight n P) hij exact cubePhaseSquare_comp_injective_le (divisorStarWeight n P) f hf x theorem cubePhaseSquare_prefix_le_actual_divisorStar {ι : Type*} [Fintype ι] {n : ℕ} {P : Finset ℕ} (hn : 0 < n) (hP : ∀ p ∈ P, p.Prime) (hfresh : ∀ p ∈ P, ¬ p ∣ n) (w : ι → ℕ) (hw : Function.Injective w) (hdvd : ∀ i, w i ∣ n) (x : AddCircle (1 : ℝ)) : cubePhaseSquare w x ≤ ∑ d ∈ divisorStar n P, ‖d • x‖ ^ 2 := by rw [← cubePhaseSquare_divisorStar_eq hP hfresh] exact cubePhaseSquare_le_divisorStar_of_injective_dvd hn P w hw hdvd x end Erdos859Verification end /- Inlined development module: CoreBallotProbabilityRate.lean -/ section /- The actual global ballot event has the Poisson ballot exponential rate. This event does not include the additional proper-core anchor conditions. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification noncomputable def coreGlobalBallotRate (lam : ℝ) : ℝ := lam * log 2 - 1 - log (lam * log 2) noncomputable def coreGlobalBallotMain (lam : ℝ) (k : ℕ) : ℝ := exp (-(k : ℝ) * coreGlobalBallotRate lam - coreBallotError lam k) / (exp 1 * (k : ℝ) ^ 2) noncomputable def coreGlobalBallotDuplicateError (k : ℕ) : ℝ := (8 * (k : ℝ) ^ 2 * (coreBallotShift k + coreBallotScale k) / (coreBallotScale k * log 2)) * exp (-(coreBallotShift k + coreBallotScale k)) noncomputable def coreGlobalBallotProbability (lam : ℝ) (k : ℕ) : ℝ := virtualPrimeBallotMass (coreBallotShift k) (coreBallotScale k) lam k noncomputable def coreGlobalBallotCorrection (lam : ℝ) (k : ℕ) : ℝ := coreBallotError lam k + 1 + 2 * log (k : ℝ) theorem coreGlobalBallot_correction_div_tendsto (lam : ℝ) : Tendsto (fun k : ℕ ↦ coreGlobalBallotCorrection lam k / k) atTop (𝓝 0) := by have hlog : Tendsto (fun k : ℕ ↦ log (k : ℝ) / k) atTop (𝓝 0) := by simpa only [Function.comp_def, id_eq] using isLittleO_log_id_atTop.tendsto_div_nhds_zero.comp (tendsto_natCast_atTop_atTop (R := ℝ)) simpa only [coreGlobalBallotCorrection, add_div, mul_div_assoc, zero_add, mul_zero] using ((coreBallot_error_div_tendsto lam).add (tendsto_const_div_atTop_nhds_zero_nat (1 : ℝ))).add (hlog.const_mul 2) theorem coreGlobalBallot_main_eq_exp {k : ℕ} (hk : 0 < k) (lam : ℝ) : coreGlobalBallotMain lam k = exp (-(k : ℝ) * coreGlobalBallotRate lam - coreGlobalBallotCorrection lam k) := by have hkR : (0 : ℝ) < k := by exact_mod_cast hk have hden : exp (1 + 2 * log (k : ℝ)) = exp 1 * (k : ℝ) ^ 2 := by rw [exp_add, show (2 : ℝ) * log (k : ℝ) = (2 : ℕ) * log (k : ℝ) by norm_num, exp_nat_mul, exp_log hkR] unfold coreGlobalBallotMain coreGlobalBallotCorrection rw [← hden, ← exp_sub] congr 1 ring theorem coreGlobalBallot_main_eventually_lower (lam : ℝ) {eps : ℝ} (heps : 0 < eps) : ∀ᶠ k : ℕ in atTop, exp (-(k : ℝ) * (coreGlobalBallotRate lam + eps)) ≤ coreGlobalBallotMain lam k := by filter_upwards [(coreGlobalBallot_correction_div_tendsto lam).eventually_lt_const heps, eventually_gt_atTop 0] with k hsmall hk have hkR : (0 : ℝ) < k := by exact_mod_cast hk have hsmall' := (div_lt_iff₀ hkR).mp hsmall rw [coreGlobalBallot_main_eq_exp hk] apply exp_le_exp.mpr nlinarith theorem coreGlobalBallot_duplicate_polynomial_bound {k : ℕ} (hk : 0 < k) : coreGlobalBallotDuplicateError k ≤ (88 / log 2 : ℝ) * (k : ℝ) ^ 3 * exp (-10 * (k : ℝ) ^ 3) := by have hkR : (1 : ℝ) ≤ k := by exact_mod_cast hk have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hB := coreBallotScale_pos k have hcoef : 8 * (k : ℝ) ^ 2 * (coreBallotShift k + coreBallotScale k) / (coreBallotScale k * log 2) ≤ (88 / log 2 : ℝ) * (k : ℝ) ^ 3 := by calc _ = (8 * (k : ℝ) ^ 2 / log 2) * (1 + coreBallotShift k / coreBallotScale k) := by field_simp; ring _ ≤ (8 * (k : ℝ) ^ 2 / log 2) * (11 * k) := by apply mul_le_mul_of_nonneg_left _ (by positivity) linarith [coreBallotShift_div_scale_le k] _ = _ := by ring have hexp : exp (-(coreBallotShift k + coreBallotScale k)) ≤ exp (-10 * (k : ℝ) ^ 3) := by apply exp_le_exp.mpr unfold coreBallotShift linarith exact mul_le_mul hcoef hexp (exp_pos _).le (by positivity) theorem coreGlobalBallot_duplicate_exp_bound {k : ℕ} (hk : 0 < k) : coreGlobalBallotDuplicateError k ≤ exp (log (528 / log 2 : ℝ) + (k : ℝ) - 10 * (k : ℝ) ^ 3) := by have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hp : (k : ℝ) ^ 3 ≤ 6 * exp (k : ℝ) := by have h := pow_div_factorial_le_exp (k : ℝ) (Nat.cast_nonneg k) 3 norm_num at h linarith calc _ ≤ (88 / log 2 : ℝ) * (k : ℝ) ^ 3 * exp (-10 * (k : ℝ) ^ 3) := coreGlobalBallot_duplicate_polynomial_bound hk _ ≤ (88 / log 2 : ℝ) * (6 * exp (k : ℝ)) * exp (-10 * (k : ℝ) ^ 3) := by gcongr _ = _ := by rw [show log (528 / log 2 : ℝ) + (k : ℝ) - 10 * (k : ℝ) ^ 3 = (log (528 / log 2 : ℝ) + (k : ℝ)) + (-10 * (k : ℝ) ^ 3) by ring, exp_add, exp_add, exp_log (by positivity : 0 < (528 / log 2 : ℝ))] ring /-- Repeated marks are negligible against every fixed exponential rate. -/ theorem coreGlobalBallot_duplicate_eventually_exponential (c : ℝ) : ∀ᶠ k : ℕ in atTop, coreGlobalBallotDuplicateError k ≤ exp (-c * (k : ℝ)) := by have hnat : Tendsto (fun k : ℕ ↦ (k : ℝ)) atTop atTop := tendsto_natCast_atTop_atTop filter_upwards [(tendsto_const_div_atTop_nhds_zero_nat (log (528 / log 2 : ℝ))).eventually_lt_const (by norm_num : (0 : ℝ) < 1), hnat.eventually_ge_atTop (c + 2), eventually_gt_atTop 0] with k hlog hc hk have hkR : (1 : ℝ) ≤ k := by exact_mod_cast hk have hkpos : (0 : ℝ) < k := by exact_mod_cast hk have hlog' : log (528 / log 2 : ℝ) ≤ k := by have h := (div_lt_iff₀ hkpos).mp hlog linarith have hk2 : (k : ℝ) ≤ (k : ℝ) ^ 2 := by nlinarith [mul_nonneg hkpos.le (sub_nonneg.mpr hkR)] have hc2 : c + 2 ≤ 10 * (k : ℝ) ^ 2 := by nlinarith [sq_nonneg (k : ℝ)] have hc3 := mul_le_mul_of_nonneg_right hc2 hkpos.le calc _ ≤ exp (log (528 / log 2 : ℝ) + (k : ℝ) - 10 * (k : ℝ) ^ 3) := coreGlobalBallot_duplicate_exp_bound hk _ ≤ _ := exp_le_exp.mpr (by nlinarith) theorem coreGlobalBallot_duplicate_eventually_le_half_main (lam : ℝ) : ∀ᶠ k : ℕ in atTop, coreGlobalBallotDuplicateError k ≤ (1 / 2 : ℝ) * coreGlobalBallotMain lam k := by have hnat : Tendsto (fun k : ℕ ↦ (k : ℝ)) atTop atTop := tendsto_natCast_atTop_atTop filter_upwards [coreGlobalBallot_duplicate_eventually_exponential (coreGlobalBallotRate lam + 2), coreGlobalBallot_main_eventually_lower lam (by norm_num : (0 : ℝ) < 1), hnat.eventually_ge_atTop (log 2)] with k hdup hmain hk have hsmall : exp (-(k : ℝ)) ≤ (1 / 2 : ℝ) := by calc _ ≤ exp (-log (2 : ℝ)) := exp_le_exp.mpr (by linarith) _ = _ := by rw [exp_neg, exp_log (by norm_num)]; norm_num calc _ ≤ exp (-(coreGlobalBallotRate lam + 2) * (k : ℝ)) := hdup _ = exp (-(k : ℝ)) * exp (-(k : ℝ) * (coreGlobalBallotRate lam + 1)) := by rw [← exp_add] congr 1 ring _ ≤ (1 / 2 : ℝ) * coreGlobalBallotMain lam k := mul_le_mul hsmall hmain (exp_pos _).le (by norm_num) theorem coreGlobalBallot_probability_eventually_lower {lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) : ∀ᶠ k : ℕ in atTop, coreGlobalBallotMain lam k - coreGlobalBallotDuplicateError k ≤ coreGlobalBallotProbability lam k := by filter_upwards [coreBallot_parameters_eventually_admissible] with k hk rcases hk with ⟨hk, hA, hB, hbase, hlarge, hAB⟩ have h := virtualPrime_ballot_probability_explicit_lower hk hA hB hbase hlam hlam2 hlarge hAB convert h using 1 <;> simp only [coreGlobalBallotMain, coreGlobalBallotDuplicateError, coreGlobalBallotProbability, coreGlobalBallotRate, coreBallotError] ring_nf /-- The main lower bound survives the removal of repeated iid marks. -/ theorem coreGlobalBallot_probability_eventually_ge_half_main {lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) : ∀ᶠ k : ℕ in atTop, (1 / 2 : ℝ) * coreGlobalBallotMain lam k ≤ coreGlobalBallotProbability lam k := by filter_upwards [coreGlobalBallot_probability_eventually_lower hlam hlam2, coreGlobalBallot_duplicate_eventually_le_half_main lam] with k hlower hdup linarith theorem coreGlobalBallot_half_main_eventually_lower (lam : ℝ) {eps : ℝ} (heps : 0 < eps) : ∀ᶠ k : ℕ in atTop, exp (-(k : ℝ) * (coreGlobalBallotRate lam + eps)) ≤ (1 / 2 : ℝ) * coreGlobalBallotMain lam k := by have hlim : Tendsto (fun k : ℕ ↦ (coreGlobalBallotCorrection lam k + log 2) / k) atTop (𝓝 0) := by simpa only [add_div, zero_add] using (coreGlobalBallot_correction_div_tendsto lam).add (tendsto_const_div_atTop_nhds_zero_nat (log 2)) filter_upwards [hlim.eventually_lt_const heps, eventually_gt_atTop 0] with k hsmall hk have hkR : (0 : ℝ) < k := by exact_mod_cast hk have hsmall' := (div_lt_iff₀ hkR).mp hsmall calc _ ≤ exp (-(k : ℝ) * coreGlobalBallotRate lam - coreGlobalBallotCorrection lam k - log 2) := exp_le_exp.mpr (by nlinarith) _ = (1 / 2 : ℝ) * coreGlobalBallotMain lam k := by rw [coreGlobalBallot_main_eq_exp hk, exp_sub, exp_log (by norm_num : (0 : ℝ) < 2)] ring /-- The actual global ballot probability has exponential rate at most `theta - 1 - log theta`, where `theta = lam * log 2`. This theorem asserts no proper-core anchor condition. -/ theorem coreGlobalBallot_probability_exponential_rate {lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) {eps : ℝ} (heps : 0 < eps) : ∀ᶠ k : ℕ in atTop, exp (-(k : ℝ) * (lam * log 2 - 1 - log (lam * log 2) + eps)) ≤ virtualPrimeBallotMass (coreBallotShift k) (coreBallotScale k) lam k := by filter_upwards [coreGlobalBallot_half_main_eventually_lower lam heps, coreGlobalBallot_probability_eventually_ge_half_main hlam hlam2] with k hmain hp exact hmain.trans hp end Erdos859Verification end /- Inlined development module: CoreBlockGeometry.lean -/ section /- Deterministic endpoint bounds from the prefix and early-suffix block conditions. -/ namespace Erdos859Verification open Finset Real theorem sum_dyadic_powers (K : ℕ) : (∑ j ∈ range K, (2 : ℝ) ^ j) = (2 : ℝ) ^ K - 1 := by induction K with | zero => norm_num | succ K ih => rw [sum_range_succ, ih, pow_succ]; ring theorem sum_shifted_dyadic_powers (n K : ℕ) : (∑ j ∈ range K, (2 : ℝ) ^ (n + j)) = (2 : ℝ) ^ (n + K) - (2 : ℝ) ^ n := by simp only [pow_add, ← mul_sum, sum_dyadic_powers] ring /-- The exact prefix and suffix estimate, before spending the prefix allowance. -/ theorem core_block_prefix_suffix_sum_upper (v : ℕ → ℝ) (n K : ℕ) {q : ℝ} (hprefix : ∀ i < n, v i ≤ (2 : ℝ) ^ n) (hsuffix : ∀ j < K, v (n + j) ≤ q * (2 : ℝ) ^ (n + j)) : (∑ i ∈ range (n + K), v i) ≤ (n : ℝ) * (2 : ℝ) ^ n + q * ((2 : ℝ) ^ (n + K) - (2 : ℝ) ^ n) := by rw [sum_range_add] apply add_le_add · simpa only [sum_const, card_range, nsmul_eq_mul] using sum_le_sum (fun i hi ↦ hprefix i (mem_range.mp hi)) · have h := sum_le_sum (fun j hj ↦ hsuffix j (mem_range.mp hj)) simpa only [← mul_sum, sum_shifted_dyadic_powers] using h /-- A short early suffix controls the mass of a whole block. -/ theorem core_block_prefix_suffix_sum_le (v : ℕ → ℝ) (n K : ℕ) {q eps : ℝ} (hq : 0 ≤ q) (hsize : (n : ℝ) ≤ eps * (2 : ℝ) ^ K) (hprefix : ∀ i < n, v i ≤ (2 : ℝ) ^ n) (hsuffix : ∀ j < K, v (n + j) ≤ q * (2 : ℝ) ^ (n + j)) : (∑ i ∈ range (n + K), v i) ≤ (q + eps) * (2 : ℝ) ^ (n + K) := by apply (core_block_prefix_suffix_sum_upper v n K hprefix hsuffix).trans have hp : (n : ℝ) * (2 : ℝ) ^ n ≤ eps * (2 : ℝ) ^ (n + K) := by have h := mul_le_mul_of_nonneg_right hsize (pow_nonneg (by norm_num : (0 : ℝ) ≤ 2) n) simpa only [pow_add, mul_assoc, mul_comm, mul_left_comm] using h have hqpow : 0 ≤ q * (2 : ℝ) ^ n := mul_nonneg hq (by positivity) nlinarith theorem core_block_exp_sum_le (y : ℕ → ℝ) (n K : ℕ) {eta eps : ℝ} (hsize : (n : ℝ) ≤ eps * (2 : ℝ) ^ K) (hprefix : ∀ i < n, y i ≤ (n : ℝ) * log 2) (hsuffix : ∀ j < K, y (n + j) ≤ ((n + j : ℕ) : ℝ) * log 2 + eta) : (∑ i ∈ range (n + K), exp (y i)) ≤ (exp eta + eps) * (2 : ℝ) ^ (n + K) := by apply core_block_prefix_suffix_sum_le (fun i ↦ exp (y i)) n K (exp_pos eta).le hsize · intro i hi simpa only [exp_nat_mul, exp_log (by norm_num : (0 : ℝ) < 2)] using exp_le_exp.mpr (hprefix i hi) · intro j hj simpa only [exp_add, exp_nat_mul, exp_log (by norm_num : (0 : ℝ) < 2), mul_comm] using exp_le_exp.mpr (hsuffix j hj) theorem core_block_translated_sum_le (v : ℕ → ℝ) (s n K : ℕ) {q eps : ℝ} (hq : 0 ≤ q) (hsize : (n : ℝ) ≤ eps * (2 : ℝ) ^ K) (hprefix : ∀ i < n, v (s + i) ≤ (2 : ℝ) ^ (s + n)) (hsuffix : ∀ j < K, v (s + (n + j)) ≤ q * (2 : ℝ) ^ (s + (n + j))) : (∑ i ∈ range (n + K), v (s + i)) ≤ (q + eps) * (2 : ℝ) ^ (s + (n + K)) := by have hspos : (0 : ℝ) < 2 ^ s := by positivity have hu := core_block_prefix_suffix_sum_le (fun i ↦ v (s + i) / (2 : ℝ) ^ s) n K hq hsize (fun i hi ↦ (div_le_iff₀ hspos).mpr (by simpa only [pow_add, mul_comm] using hprefix i hi)) (fun j hj ↦ (div_le_iff₀ hspos).mpr (by simpa only [pow_add, mul_comm, mul_left_comm, mul_assoc] using hsuffix j hj)) rw [← sum_div] at hu have hm := (div_le_iff₀ hspos).mp hu simpa only [pow_add, mul_comm, mul_left_comm, mul_assoc] using hm theorem sum_range_blocks (v : ℕ → ℝ) (r h : ℕ) : (∑ i ∈ range (r * h), v i) = ∑ b ∈ range r, ∑ j ∈ range h, v (b * h + j) := by induction r with | zero => simp | succ r ih => rw [Nat.succ_mul, sum_range_add, ih, sum_range_succ] theorem core_block_dyadic_telescope (r h : ℕ) : ((2 : ℝ) ^ h - 1) * (∑ b ∈ range r, (2 : ℝ) ^ ((b + 1) * h)) = (2 : ℝ) ^ h * ((2 : ℝ) ^ (r * h) - 1) := by induction r with | zero => norm_num | succ r ih => rw [sum_range_succ, mul_add, ih] simp only [Nat.add_mul, one_mul, pow_add] ring theorem core_block_geometric_sum_le (r : ℕ) {h : ℕ} (hh : 0 < h) : (∑ b ∈ range r, (2 : ℝ) ^ ((b + 1) * h)) ≤ (2 : ℝ) ^ (r * h) / (1 - ((2 : ℝ) ^ h)⁻¹) := by have hp : (1 : ℝ) < 2 ^ h := one_lt_pow₀ (by norm_num) (Nat.ne_of_gt hh) have hden : 0 < 1 - ((2 : ℝ) ^ h)⁻¹ := by have hinv := inv_lt_one_of_one_lt₀ hp linarith apply (le_div_iff₀ hden).mpr have heq : (∑ b ∈ range r, (2 : ℝ) ^ ((b + 1) * h)) * (1 - ((2 : ℝ) ^ h)⁻¹) = (2 : ℝ) ^ (r * h) - 1 := by apply (mul_right_cancel₀ (by positivity : (2 : ℝ) ^ h ≠ 0)) calc _ = ((2 : ℝ) ^ h - 1) * (∑ b ∈ range r, (2 : ℝ) ^ ((b + 1) * h)) := by field_simp _ = (2 : ℝ) ^ h * ((2 : ℝ) ^ (r * h) - 1) := core_block_dyadic_telescope r h _ = _ := mul_comm _ _ rw [heq] linarith /-- Summing translated block estimates gives the denominator in (14). -/ theorem core_blocks_endpoint_sum_le (v : ℕ → ℝ) (r : ℕ) {h : ℕ} (hh : 0 < h) {C : ℝ} (hC : 0 ≤ C) (hblock : ∀ b < r, (∑ j ∈ range h, v (b * h + j)) ≤ C * (2 : ℝ) ^ ((b + 1) * h)) : (∑ i ∈ range (r * h), v i) ≤ C * (2 : ℝ) ^ (r * h) / (1 - ((2 : ℝ) ^ h)⁻¹) := by rw [sum_range_blocks] calc _ ≤ ∑ b ∈ range r, C * (2 : ℝ) ^ ((b + 1) * h) := sum_le_sum (fun b hb ↦ hblock b (mem_range.mp hb)) _ = C * ∑ b ∈ range r, (2 : ℝ) ^ ((b + 1) * h) := (mul_sum _ _ _).symm _ ≤ C * ((2 : ℝ) ^ (r * h) / (1 - ((2 : ℝ) ^ h)⁻¹)) := mul_le_mul_of_nonneg_left (core_block_geometric_sum_le r hh) hC _ = _ := by ring theorem core_blocks_prefix_suffix_endpoint_sum_le (v : ℕ → ℝ) (r n K : ℕ) (hh : 0 < n + K) {q eps : ℝ} (hq : 0 ≤ q) (hsize : (n : ℝ) ≤ eps * (2 : ℝ) ^ K) (hprefix : ∀ b < r, ∀ i < n, v (b * (n + K) + i) ≤ (2 : ℝ) ^ (b * (n + K) + n)) (hsuffix : ∀ b < r, ∀ j < K, v (b * (n + K) + (n + j)) ≤ q * (2 : ℝ) ^ (b * (n + K) + (n + j))) : (∑ i ∈ range (r * (n + K)), v i) ≤ (q + eps) * (2 : ℝ) ^ (r * (n + K)) / (1 - ((2 : ℝ) ^ (n + K))⁻¹) := by have heps : 0 ≤ eps := nonneg_of_mul_nonneg_left ((Nat.cast_nonneg n).trans hsize) (by positivity : (0 : ℝ) < 2 ^ K) apply core_blocks_endpoint_sum_le v r hh (add_nonneg hq heps) intro b hb simpa only [Nat.add_mul, one_mul] using core_block_translated_sum_le v (b * (n + K)) n K hq hsize (hprefix b hb) (hsuffix b hb) /-- The exponential endpoint estimate (14), with an arbitrary prefix allowance. -/ theorem core_blocks_exp_endpoint_sum_le (y : ℕ → ℝ) (r n K : ℕ) (hh : 0 < n + K) {eta eps : ℝ} (hsize : (n : ℝ) ≤ eps * (2 : ℝ) ^ K) (hprefix : ∀ b < r, ∀ i < n, y (b * (n + K) + i) ≤ ((b * (n + K) + n : ℕ) : ℝ) * log 2) (hsuffix : ∀ b < r, ∀ j < K, y (b * (n + K) + (n + j)) ≤ ((b * (n + K) + (n + j) : ℕ) : ℝ) * log 2 + eta) : (∑ i ∈ range (r * (n + K)), exp (y i)) ≤ (exp eta + eps) * (2 : ℝ) ^ (r * (n + K)) / (1 - ((2 : ℝ) ^ (n + K))⁻¹) := by apply core_blocks_prefix_suffix_endpoint_sum_le (fun i ↦ exp (y i)) r n K hh (exp_pos eta).le hsize · intro b hb i hi simpa only [exp_nat_mul, exp_log (by norm_num : (0 : ℝ) < 2)] using exp_le_exp.mpr (hprefix b hb i hi) · intro b hb j hj simpa only [exp_add, exp_nat_mul, exp_log (by norm_num : (0 : ℝ) < 2), mul_comm] using exp_le_exp.mpr (hsuffix b hb j hj) end Erdos859Verification end /- Inlined development module: FordBarrierAnalytic.lean -/ section /- Elementary analytic factors in Ford's upper barrier estimate. No first-crossing simplex identity or full barrier estimate is assumed here. -/ open Real namespace Erdos859Verification theorem ford_log_one_sub_upper {a : ℝ} (ha : 0 ≤ a) (ha1 : a < 1) : log (1 - a) ≤ -(2 * a / (2 - a)) := by have hd : 0 < 1 - a := by linarith have hd2 : 0 < 2 - a := by linarith have h := le_log_one_add_of_nonneg (div_nonneg ha hd.le) have heq : 1 + a / (1 - a) = (1 - a)⁻¹ := by field_simp; ring have hrat : 2 * (a / (1 - a)) / (a / (1 - a) + 2) = 2 * a / (2 - a) := by field_simp ring rw [heq, log_inv, hrat] at h linarith /-- The ordered two-sided perturbation has at least the linear logarithmic loss. -/ theorem ford_log_ratio_upper {a b : ℝ} (hb : 0 ≤ b) (hba : b ≤ a) (ha1 : a < 1) : log (1 - a) - log (1 + b) ≤ -(a + b) := by have ha : 0 ≤ a := hb.trans hba have hd : 0 < 2 - a := by linarith have hd' : 0 < 2 + b := by linarith have hsq : b ^ 2 / (2 + b) ≤ a ^ 2 / (2 - a) := by calc _ ≤ a ^ 2 / (2 + b) := div_le_div_of_nonneg_right (by nlinarith) hd'.le _ ≤ _ := div_le_div_of_nonneg_left (sq_nonneg a) hd (by linarith) have hfirst := ford_log_one_sub_upper ha ha1 have hsecond := le_log_one_add_of_nonneg hb have hrat : -(2 * a / (2 - a)) - 2 * b / (b + 2) = -(a + b) - a ^ 2 / (2 - a) + b ^ 2 / (2 + b) := by field_simp ring linarith /-- The boundary `A = n` is included: its left side vanishes for positive `n`. -/ theorem ford_power_ratio_upper {n : ℕ} (hn : 0 < n) {A B : ℝ} (hB : 0 ≤ B) (hBA : B ≤ A) (hAn : A ≤ n) : (((n : ℝ) - A) / ((n : ℝ) + B)) ^ n ≤ exp (-A - B) := by have hnR : (0 : ℝ) < n := by exact_mod_cast hn rcases hAn.eq_or_lt with hA | hA · rw [hA, sub_self, zero_div, zero_pow hn.ne'] exact (exp_pos _).le · have hsmall : A / n < 1 := (div_lt_one hnR).mpr hA have h := ford_log_ratio_upper (div_nonneg hB hnR.le) (div_le_div_of_nonneg_right hBA hnR.le) hsmall have hpos : 0 < 1 - A / n := by linarith have hpos' : 0 < 1 + B / n := by positivity have hr : ((n : ℝ) - A) / ((n : ℝ) + B) = (1 - A / n) / (1 + B / n) := by field_simp have hmul := mul_le_mul_of_nonneg_left h hnR.le calc _ = exp ((n : ℝ) * (log (1 - A / n) - log (1 + B / n))) := by rw [hr, ← log_div hpos.ne' hpos'.ne', exp_nat_mul, exp_log (div_pos hpos hpos')] _ ≤ exp (-A - B) := by apply exp_le_exp.mpr have hid : (n : ℝ) * (-(A / n + B / n)) = -A - B := by field_simp; ring linarith /-- A quadratic lower bound obtained from `1 - x⁻¹ ≤ log x`. -/ theorem ford_log_one_sub_lower {z : ℝ} (_hz : 0 ≤ z) (hz2 : z ≤ 1 / 2) : -z - 2 * z ^ 2 ≤ log (1 - z) := by have hd : 0 < 1 - z := by linarith have h := one_sub_inv_le_log_of_pos hd have hinv : (1 - z)⁻¹ ≤ 1 + z + 2 * z ^ 2 := by rw [← one_div] apply (div_le_iff₀ hd).mpr nlinarith [mul_nonneg (sq_nonneg z) (show 0 ≤ 1 - 2 * z by linarith)] linarith theorem ford_barrier_exponent_lower {k u w v : ℝ} (hk : 0 < k) (hu : 0 ≤ u) (hw : 0 ≤ w) (hv : v = k + w - u) (hkv : k / 2 ≤ v) (hsmall : 2 * (2 * w + 2) ≤ v) : -(4 * u * (w + 1) + 32 * (w + 1) ^ 2) / k ≤ 2 * w + 2 + k * log (1 - (2 * w + 2) / v) := by have hvpos : 0 < v := by linarith have hz : 0 ≤ (2 * w + 2) / v := by positivity have hz2 : (2 * w + 2) / v ≤ 1 / 2 := by apply (div_le_iff₀ hvpos).mpr linarith have hlog := mul_le_mul_of_nonneg_left (ford_log_one_sub_lower hz hz2) hk.le have hrecip2 : k / v ^ 2 ≤ 4 / k := by apply (div_le_div_iff₀ (sq_pos_of_pos hvpos) hk).mpr nlinarith [mul_nonneg (show 0 ≤ 2 * v - k by linarith) (show 0 ≤ 2 * v + k by positivity)] have hfirst : -(4 * u * (w + 1)) / k ≤ 2 * (w + 1) * (w - u) / v := by apply (div_le_div_iff₀ hk hvpos).mpr have hd : 0 ≤ 2 * v - k := by linarith have hm : 0 ≤ 2 * (w + 1) * (k * w + u * (2 * v - k)) := by positivity nlinarith only [hm] have hsecond : -(32 * (w + 1) ^ 2) / k ≤ -(8 * k * (w + 1) ^ 2 / v ^ 2) := by have hm := mul_le_mul_of_nonneg_left hrecip2 (show 0 ≤ 8 * (w + 1) ^ 2 by positivity) calc _ = -(8 * (w + 1) ^ 2 * (4 / k)) := by ring _ ≤ -(8 * (w + 1) ^ 2 * (k / v ^ 2)) := neg_le_neg hm _ = _ := by ring have hid : 2 * w + 2 + k * (-((2 * w + 2) / v) - 2 * ((2 * w + 2) / v) ^ 2) = 2 * (w + 1) * (w - u) / v - 8 * k * (w + 1) ^ 2 / v ^ 2 := by field_simp [hvpos.ne'] rw [hv] ring have hsum := add_le_add hfirst hsecond rw [← sub_eq_add_neg, ← hid] at hsum have hleft : -(4 * u * (w + 1)) / k + -(32 * (w + 1) ^ 2) / k = -(4 * u * (w + 1) + 32 * (w + 1) ^ 2) / k := by ring rw [hleft] at hsum linarith /-- Ford's final analytic margin, independently of the first-crossing decomposition. -/ theorem ford_barrier_final_margin {k : ℕ} (hk : 0 < k) {u w v : ℝ} (hu : 0 ≤ u) (hw : 0 ≤ w) (hv : v = (k : ℝ) + w - u) (hkv : (k : ℝ) / 2 ≤ v) (hsmall : 2 * (2 * w + 2) ≤ v) : 1 - exp (2 * w + 2) * (1 - (2 * w + 2) / v) ^ k ≤ 36 * (u + 1) * (w + 1) ^ 2 / k := by have hkR : (0 : ℝ) < k := by exact_mod_cast hk have hvpos : 0 < v := by linarith have hz2 : (2 * w + 2) / v ≤ 1 / 2 := by apply (div_le_iff₀ hvpos).mpr linarith have hbase : 0 < 1 - (2 * w + 2) / v := by linarith have he := ford_barrier_exponent_lower hkR hu hw hv hkv hsmall rw [neg_div] at he have hexp := add_one_le_exp (2 * w + 2 + (k : ℝ) * log (1 - (2 * w + 2) / v)) have hid : exp (2 * w + 2 + (k : ℝ) * log (1 - (2 * w + 2) / v)) = exp (2 * w + 2) * (1 - (2 * w + 2) / v) ^ k := by rw [exp_add, exp_nat_mul, exp_log hbase] rw [hid] at hexp have hpoly : 4 * u * (w + 1) + 32 * (w + 1) ^ 2 ≤ 36 * (u + 1) * (w + 1) ^ 2 := by nlinarith [mul_nonneg hu (sq_nonneg w), mul_nonneg hu hw, sq_nonneg w] have hquot := div_le_div_of_nonneg_right hpoly hkR.le linarith end Erdos859Verification end /- Inlined development module: PrimePairEventTransfer.lean -/ section /- Robust continuous shift events transfer to the exact finite prime-pair law. -/ namespace Erdos859Verification open Finset Real MeasureTheory open scoped ENNReal theorem coupling_robust_event_le (mu : Measure (ℝ × ℝ)) [IsProbabilityMeasure mu] {r : ℝ} (hr : mu {z | |z.1 - z.2| ≤ r} = 1) {E G : Set ℝ} (hE : MeasurableSet E) (hG : MeasurableSet G) (hrobust : ∀ x ∈ E, ∀ y, |y - x| ≤ r → y ∈ G) : (Measure.map Prod.snd mu) E ≤ (Measure.map Prod.fst mu) G := by have hB : MeasurableSet {z : ℝ × ℝ | |z.1 - z.2| ≤ r} := by measurability have hnull := (prob_compl_eq_zero_iff hB).mpr hr rw [Measure.map_apply measurable_snd hE, Measure.map_apply measurable_fst hG, ← measure_inter_conull hnull] apply measure_mono intro z hz exact hrobust z.2 hz.1 z.1 hz.2 theorem pairDifferenceCoupling_isProbability (mu : Measure (ℝ × ℝ)) [IsProbabilityMeasure mu] : IsProbabilityMeasure (pairDifferenceCoupling mu) := Measure.isProbabilityMeasure_map measurable_pairCoupledDifference.aemeasurable theorem primeLogOddsPair_event_transfer {lam u w : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) {E G : Set ℝ} (hE : MeasurableSet E) (hG : MeasurableSet G) (hrobust : ∀ x ∈ E, ∀ y, |y - x| ≤ 32 * primeLogOddsErrorConstant → y ∈ G) : translationShiftLaw (logUniformPairDensity u w) E ≤ (Measure.map (fun z : ℝ × ℝ ↦ z.1 - z.2) ((primeLogOddsLogLaw lam u w).prod (primeLogOddsLogLaw lam u w))) G := by let : IsProbabilityMeasure (primeLogOddsQuantileCoupling lam u w) := finiteQuantileCoupling_isProbability _ _ (measurable_logUniformQuantile u w) let : IsProbabilityMeasure (primeLogOddsPairQuantileCoupling lam u w) := pairDifferenceCoupling_isProbability _ have h := primeLogOddsPairQuantileCoupling_properties hlam hlam2 hu hw hwu hlarge simpa only [h.1, h.2.1] using coupling_robust_event_le _ h.2.2 hE hG hrobust theorem primeReciprocalOddsPair_event_transfer {u w : ℝ} (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) {E G : Set ℝ} (hE : MeasurableSet E) (hG : MeasurableSet G) (hrobust : ∀ x ∈ E, ∀ y, |y - x| ≤ 32 * primeLogOddsErrorConstant → y ∈ G) : translationShiftLaw (logUniformPairDensity u w) E ≤ (Measure.map (fun z : ℝ × ℝ ↦ z.1 - z.2) ((primeReciprocalOddsLogLaw u w).prod (primeReciprocalOddsLogLaw u w))) G := by let : IsProbabilityMeasure (primeReciprocalOddsQuantileCoupling u w) := finiteQuantileCoupling_isProbability _ _ (measurable_logUniformQuantile u w) let : IsProbabilityMeasure (primeReciprocalOddsPairQuantileCoupling u w) := pairDifferenceCoupling_isProbability _ have h := primeReciprocalOddsPairQuantileCoupling_properties hu hw hwu hlarge simpa only [h.1, h.2.1] using coupling_robust_event_le _ h.2.2 hE hG hrobust theorem finiteIndexedMarkLaw_difference_apply {ι : Type*} (P : Finset ι) (a : ι → ℝ) (f : ι → ℝ) {G : Set ℝ} [DecidablePred (· ∈ G)] (hG : MeasurableSet G) : (Measure.map (fun z : ℝ × ℝ ↦ z.1 - z.2) ((finiteIndexedMarkLaw P a f).prod (finiteIndexedMarkLaw P a f))) G = ∑ p ∈ P, ∑ q ∈ P, ENNReal.ofReal (a p) * ENNReal.ofReal (a q) * (if f p - f q ∈ G then 1 else 0) := by classical let : SFinite (finiteIndexedMarkLaw P a f) := by unfold finiteIndexedMarkLaw rw [← Finset.sum_coe_sort, ← Measure.sum_fintype] infer_instance rw [Measure.map_apply (by fun_prop) hG, Measure.prod_apply (hG.preimage (by fun_prop))] simp only [finiteIndexedMarkLaw, lintegral_finsetSum_measure, lintegral_smul_measure, smul_eq_mul, lintegral_dirac, Measure.coe_finsetSum, Finset.sum_apply, Measure.smul_apply, mul_sum] apply sum_congr rfl intro p _ apply sum_congr rfl intro q _ rw [Measure.dirac_apply' _ ((hG.preimage (by fun_prop)).preimage measurable_prodMk_left)] simp only [Set.indicator_apply, Set.mem_preimage, Pi.one_apply] ring theorem finiteIndexedMarkLaw_difference_real {ι : Type*} {P : Finset ι} {a : ι → ℝ} (ha : ∀ p ∈ P, 0 ≤ a p) (f : ι → ℝ) {G : Set ℝ} [DecidablePred (· ∈ G)] (hG : MeasurableSet G) : ((Measure.map (fun z : ℝ × ℝ ↦ z.1 - z.2) ((finiteIndexedMarkLaw P a f).prod (finiteIndexedMarkLaw P a f))) G).toReal = ∑ p ∈ P, ∑ q ∈ P, a p * a q * (if f p - f q ∈ G then 1 else 0) := by classical rw [finiteIndexedMarkLaw_difference_apply P a f hG] have ht (p q : ι) : ENNReal.ofReal (a p) * ENNReal.ofReal (a q) * (if f p - f q ∈ G then 1 else 0) ≠ ∞ := by split_ifs · simpa only [mul_one] using ENNReal.mul_ne_top ENNReal.ofReal_ne_top ENNReal.ofReal_ne_top · simp rw [ENNReal.toReal_sum (fun p _ ↦ ENNReal.sum_ne_top.mpr (fun q _ ↦ ht p q))] apply sum_congr rfl intro p hp rw [ENNReal.toReal_sum (fun q _ ↦ ht p q)] apply sum_congr rfl intro q hq simp only [ENNReal.toReal_mul, ENNReal.toReal_ofReal (ha p hp), ENNReal.toReal_ofReal (ha q hq)] split_ifs <;> simp theorem finiteIndexedMarkLaw_difference_ne_top {ι : Type*} (P : Finset ι) (a : ι → ℝ) (f : ι → ℝ) {G : Set ℝ} (hG : MeasurableSet G) : (Measure.map (fun z : ℝ × ℝ ↦ z.1 - z.2) ((finiteIndexedMarkLaw P a f).prod (finiteIndexedMarkLaw P a f))) G ≠ ∞ := by classical rw [finiteIndexedMarkLaw_difference_apply P a f hG] apply ENNReal.sum_ne_top.mpr intro p _ apply ENNReal.sum_ne_top.mpr intro q _ split_ifs · simpa only [mul_one] using ENNReal.mul_ne_top ENNReal.ofReal_ne_top ENNReal.ofReal_ne_top · simp theorem primeLogOddsPair_event_finite_lower {lam u w rho : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) {E G : Set ℝ} [DecidablePred (· ∈ G)] (hE : MeasurableSet E) (hG : MeasurableSet G) (hrobust : ∀ x ∈ E, ∀ y, |y - x| ≤ 32 * primeLogOddsErrorConstant → y ∈ G) (hrho : rho ≤ (translationShiftLaw (logUniformPairDensity u w) E).toReal) : rho ≤ ∑ p ∈ primeLogWindow u (u + w), ∑ q ∈ primeLogWindow u (u + w), primeLogOddsMarkWeight lam u (u + w) p * primeLogOddsMarkWeight lam u (u + w) q * (if log (p : ℝ) - log (q : ℝ) ∈ G then 1 else 0) := by have h := primeLogOddsPair_event_transfer hlam hlam2 hu hw hwu hlarge hE hG hrobust have hn := primeLogOddsMark_additive_normalized hlam hlam2 hu hw hwu hlarge have ht := ENNReal.toReal_mono (finiteIndexedMarkLaw_difference_ne_top _ _ _ hG) h rw [finiteIndexedMarkLaw_difference_real hn.1 _ hG] at ht exact hrho.trans ht theorem primeReciprocalOddsPair_event_finite_lower {u w rho : ℝ} (hu : log 2 ≤ u) (hw : 0 < w) (hwu : w ≤ u) (hlarge : 8 * primeLogOddsErrorConstant ≤ w) {E G : Set ℝ} [DecidablePred (· ∈ G)] (hE : MeasurableSet E) (hG : MeasurableSet G) (hrobust : ∀ x ∈ E, ∀ y, |y - x| ≤ 32 * primeLogOddsErrorConstant → y ∈ G) (hrho : rho ≤ (translationShiftLaw (logUniformPairDensity u w) E).toReal) : rho ≤ ∑ p ∈ primeLogWindow u (u + w), ∑ q ∈ primeLogWindow u (u + w), primeReciprocalOddsMarkWeight u (u + w) p * primeReciprocalOddsMarkWeight u (u + w) q * (if log (p : ℝ) - log (q : ℝ) ∈ G then 1 else 0) := by have h := primeReciprocalOddsPair_event_transfer hu hw hwu hlarge hE hG hrobust have hn := primeReciprocalOddsMarkWeight_normalized hu hw hwu hlarge have ht := ENNReal.toReal_mono (finiteIndexedMarkLaw_difference_ne_top _ _ _ hG) h rw [finiteIndexedMarkLaw_difference_real (fun p hp ↦ (hn.1 p hp).le) _ hG] at ht exact hrho.trans ht theorem finite_pair_tuple_sum {α : Type*} [Fintype α] (a : α → ℝ) (F : α → α → ℝ) : (∑ x : Fin 2 → α, finiteProductWeight (fun _ ↦ a) x * F (x 0) (x 1)) = ∑ p, ∑ q, a p * a q * F p q := by classical rw [← Fintype.sum_prod_type' (fun p q ↦ a p * a q * F p q)] apply Fintype.sum_equiv (finTwoArrowEquiv α) intro x simp only [finiteProductWeight, Fin.prod_univ_two, finTwoArrowEquiv_apply] rfl def PrimeSubsetPairEvent (G : Set ℝ) (T : Finset ℕ) : Prop := ∃ p ∈ T, ∃ q ∈ T, log (p : ℝ) - log (q : ℝ) ∈ G theorem primeSubsetPairEvent_tupleSupport {P : Finset ℕ} {G : Set ℝ} (x : Fin 2 → P) (hx : log ((x 0).val : ℝ) - log ((x 1).val : ℝ) ∈ G) : PrimeSubsetPairEvent G (tupleSupport x) := ⟨(x 0).val, mem_image_of_mem _ (mem_univ 0), (x 1).val, mem_image_of_mem _ (mem_univ 1), hx⟩ theorem primeIntensityPair_bad_subset_le {P : Finset ℕ} {lam rho : ℝ} (hP : ∀ p ∈ P, p.Prime) (hlam : 0 < lam) (hM : 0 < ∑ p ∈ P, primeLogOddsIntensity lam p) {G : Set ℝ} [DecidablePred (· ∈ G)] [DecidablePred (PrimeSubsetPairEvent G)] (hgood : rho ≤ ∑ p ∈ P, ∑ q ∈ P, (primeLogOddsIntensity lam p / ∑ r ∈ P, primeLogOddsIntensity lam r) * (primeLogOddsIntensity lam q / ∑ r ∈ P, primeLogOddsIntensity lam r) * (if log (p : ℝ) - log (q : ℝ) ∈ G then 1 else 0)) : (∑ x : Fin 2 → P, primeIntensityTupleWeight lam x * (if PrimeSubsetPairEvent G (tupleSupport x) then 0 else 1)) ≤ 1 - rho := by classical let a : P → ℝ := fun p ↦ primeLogOddsIntensity lam p.val / ∑ r ∈ P, primeLogOddsIntensity lam r have ha (p : P) : 0 ≤ a p := div_nonneg (primeLogOddsIntensity_le_odds hlam (hP p.val p.property)).1 hM.le have hw (x : Fin 2 → P) : 0 ≤ primeIntensityTupleWeight lam x := finiteProductWeight_nonneg (fun _ ↦ ha) x have hsum : (∑ x : Fin 2 → P, primeIntensityTupleWeight lam x * (if log ((x 0).val : ℝ) - log ((x 1).val : ℝ) ∈ G then 1 else 0)) = ∑ p ∈ P, ∑ q ∈ P, (primeLogOddsIntensity lam p / ∑ r ∈ P, primeLogOddsIntensity lam r) * (primeLogOddsIntensity lam q / ∑ r ∈ P, primeLogOddsIntensity lam r) * (if log (p : ℝ) - log (q : ℝ) ∈ G then 1 else 0) := by calc _ = ∑ p : P, ∑ q : P, a p * a q * (if log (p.val : ℝ) - log (q.val : ℝ) ∈ G then 1 else 0) := finite_pair_tuple_sum a (fun p q : P ↦ if log (p.val : ℝ) - log (q.val : ℝ) ∈ G then 1 else 0) _ = _ := by let F : ℕ → ℕ → ℝ := fun p q ↦ (primeLogOddsIntensity lam p / ∑ r ∈ P, primeLogOddsIntensity lam r) * (primeLogOddsIntensity lam q / ∑ r ∈ P, primeLogOddsIntensity lam r) * (if log (p : ℝ) - log (q : ℝ) ∈ G then 1 else 0) change (∑ p : P, ∑ q : P, F p.val q.val) = ∑ p ∈ P, ∑ q ∈ P, F p q rw [Finset.sum_coe_sort P (fun p : ℕ ↦ ∑ q : P, F p q.val)] apply sum_congr rfl intro p _ exact Finset.sum_coe_sort P (F p) have hp (x : Fin 2 → P) : primeIntensityTupleWeight lam x * (if PrimeSubsetPairEvent G (tupleSupport x) then 0 else 1) + primeIntensityTupleWeight lam x * (if log ((x 0).val : ℝ) - log ((x 1).val : ℝ) ∈ G then 1 else 0) ≤ primeIntensityTupleWeight lam x := by by_cases hx : log ((x 0).val : ℝ) - log ((x 1).val : ℝ) ∈ G · simp [hx, primeSubsetPairEvent_tupleSupport x hx] · simp only [hx, ↓reduceIte, mul_zero, add_zero] split_ifs <;> simp [hw x] have hs := sum_le_sum (fun x (_ : x ∈ univ) ↦ hp x) rw [sum_add_distrib, primeIntensityTupleWeight_normalized hM 2, hsum] at hs linarith /-- A robust continuous event supplies two distinct selected primes. The duplicate correction is explicit; the selected-subset law is the tilted law. -/ theorem primeTilt_broad_robust_pair_lower {lam u eps rho eta : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * primeLogOddsErrorConstant ≤ eps * u) {E G : Set ℝ} [DecidablePred (· ∈ G)] [DecidablePred (PrimeSubsetPairEvent G)] (hE : MeasurableSet E) (hG : MeasurableSet G) (hrobust : ∀ x ∈ E, ∀ y, |y - x| ≤ 32 * primeLogOddsErrorConstant → y ∈ G) (hrho : rho ≤ (translationShiftLaw (logUniformPairDensity u (eps * u)) E).toReal) (heta : 0 ≤ eta) (hmargin : eta ≤ rho - 64 * exp (-u) / eps) : eta * exp (-5 * eps) * (eps / 4) ^ 2 / 2 ≤ ∑ T ∈ (primeLogWindow u ((1 + eps) * u)).powerset.filter (fun T ↦ T.card = 2 ∧ PrimeSubsetPairEvent G T), primeTiltWeight (primeLogWindow u ((1 + eps) * u)) lam T := by classical have hu0 : 0 < u := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hu have hw : 0 < eps * u := mul_pos heps hu0 have hwu : eps * u ≤ u := mul_le_of_le_one_left hu0.le heps1 have hlarge' : 8 * mertensErrorConstant ≤ eps * u := by unfold primeLogOddsErrorConstant at hlarge linarith have hend : u + eps * u = (1 + eps) * u := by ring have hgood := primeLogOddsPair_event_finite_lower hlam hlam2 hu hw hwu hlarge hE hG hrobust hrho rw [hend] at hgood have hM : 0 < ∑ p ∈ primeLogWindow u ((1 + eps) * u), primeLogOddsIntensity lam p := (by positivity : 0 < eps / 4).trans_le (primeLogOddsIntensity_broad_mass_lower hlam hlam2 hu heps heps1 hlarge') have hbad := primeIntensityPair_bad_subset_le (fun p hp ↦ (mem_primeLogWindow.mp hp).1) (by linarith : 0 < lam) hM hgood have hm : eta ≤ 1 - (1 - rho) - (2 : ℝ) ^ 2 * (16 * exp (-u) / eps) := by convert hmargin using 1 ring have h := primeTilt_broad_good_count_lower hlam hlam2 hu heps heps1 hlarge' 2 (PrimeSubsetPairEvent G) heta hm hbad norm_num only [Nat.factorial_succ, Nat.factorial_zero, Nat.cast_ofNat] at h exact h end Erdos859Verification end /- Inlined development module: CoreSuffixProbability.lean -/ section /- Exact finite tilted-prime probabilities for the early suffix-bin event. -/ namespace Erdos859Verification open Finset Real noncomputable def primeTiltSingleInMass (P S : Finset ℕ) (lam : ℝ) : ℝ := ∑ T ∈ P.powerset.filter (fun T ↦ T.card = 1 ∧ T ⊆ S), primeTiltWeight P lam T theorem sum_singleton_subsets {P S : Finset ℕ} (hS : S ⊆ P) (f : Finset ℕ → ℝ) : (∑ T ∈ P.powerset.filter (fun T ↦ T.card = 1 ∧ T ⊆ S), f T) = ∑ p ∈ S, f {p} := by classical symm apply sum_bij (fun p _ ↦ {p}) · intro p hp exact mem_filter.mpr ⟨mem_powerset.mpr (singleton_subset_iff.mpr (hS hp)), card_singleton p, singleton_subset_iff.mpr hp⟩ · intro p _ q _ hpq exact singleton_injective hpq · intro T hT obtain ⟨p, rfl⟩ := card_eq_one.mp (mem_filter.mp hT).2.1 exact ⟨p, singleton_subset_iff.mp (mem_filter.mp hT).2.2, rfl⟩ · intro p _ rfl theorem primeTiltSingleInMass_eq {P S : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hS : S ⊆ P) {lam : ℝ} (hlam : 0 < lam) : primeTiltSingleInMass P S lam = exp (-(∑ p ∈ P, primeLogOddsIntensity lam p)) * ∑ p ∈ S, lam / ((p : ℝ) - 1) := by rw [primeTiltSingleInMass, sum_singleton_subsets hS, mul_sum] apply sum_congr rfl intro p hp rw [primeTiltWeight_eq_empty_mul_tilted_odds hP (singleton_subset_iff.mpr (hS hp)), primeTiltWeight_empty_eq_exp_neg_intensity hP hlam, prod_singleton] theorem primeTiltSingleInMass_intensity_lower {P S : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hS : S ⊆ P) {lam : ℝ} (hlam : 0 < lam) : exp (-(∑ p ∈ P, primeLogOddsIntensity lam p)) * (∑ p ∈ S, primeLogOddsIntensity lam p) ≤ primeTiltSingleInMass P S lam := by rw [primeTiltSingleInMass_eq hP hS hlam] exact mul_le_mul_of_nonneg_left (sum_le_sum (fun p hp ↦ (primeLogOddsIntensity_le_odds hlam (hP p (hS hp))).2)) (exp_pos _).le theorem primeTiltSingleInMass_nonneg {P S : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {lam : ℝ} (hlam : 0 < lam) : 0 ≤ primeTiltSingleInMass P S lam := sum_nonneg (fun T _ ↦ (primeTiltWeight_pos hP hlam T).le) /-- Exact independence for arbitrary events on disjoint finite prime bands. -/ theorem prime_tilt_disjoint_band_events_product {ι : Type*} [Fintype ι] [DecidableEq ι] (P : ι → Finset ℕ) (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) (lam : ℝ) (E : ι → Finset ℕ → Prop) [∀ i, DecidablePred (E i)] : (∑ T ∈ (primeBandUnion P).powerset.filter (fun T ↦ ∀ i, E i (T ∩ P i)), primeTiltWeight (primeBandUnion P) lam T) = ∏ i, ∑ T ∈ (P i).powerset.filter (E i), primeTiltWeight (P i) lam T := by classical have h := prime_tilt_expectation_primeBand_partition P hdis lam (fun U ↦ if ∀ i, E i (U i) then 1 else 0) simp only [mul_ite, mul_one, mul_zero, ← sum_filter] at h rw [h] simp only [sum_filter] have he (U : ι → Finset ℕ) : (if ∀ i, E i (U i) then ∏ i, primeTiltWeight (P i) lam (U i) else 0) = ∏ i, primeTiltWeight (P i) lam (U i) * (if E i (U i) then (1 : ℝ) else 0) := by rw [prod_mul_distrib, prod_boole] simp only [mem_univ, forall_true_left, mul_ite, mul_one, mul_zero] simp_rw [he] symm simpa only [primeBandSelections, mul_ite, mul_one, mul_zero] using prod_univ_sum (fun i ↦ (P i).powerset) (fun i T ↦ primeTiltWeight (P i) lam T * (if E i T then (1 : ℝ) else 0)) theorem prime_tilt_disjoint_singleIn_product {ι : Type*} [Fintype ι] [DecidableEq ι] (P S : ι → Finset ℕ) (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) (lam : ℝ) : (∑ T ∈ (primeBandUnion P).powerset.filter (fun T ↦ ∀ i, (T ∩ P i).card = 1 ∧ T ∩ P i ⊆ S i), primeTiltWeight (primeBandUnion P) lam T) = ∏ i, primeTiltSingleInMass (P i) (S i) lam := by classical exact prime_tilt_disjoint_band_events_product P hdis lam (fun i T ↦ T.card = 1 ∧ T ⊆ S i) theorem shifted_exp_log_lower {A t : ℝ} (hA : 0 ≤ A) (ht : 0 < t) (eta : ℝ) : eta * t / (A + t) ≤ log ((A + t * exp eta) / (A + t)) := by have hd : 0 < A + t := by positivity have hx : 0 ≤ t / (A + t) := div_nonneg ht.le hd.le have hx1 : t / (A + t) ≤ 1 := (div_le_one hd).mpr (by linarith) have hc := strictConcaveOn_log_Ioi.concaveOn.2 (show (1 : ℝ) ∈ Set.Ioi 0 by norm_num) (show exp eta ∈ Set.Ioi 0 from exp_pos eta) (show 0 ≤ 1 - t / (A + t) by linarith) hx (by ring : 1 - t / (A + t) + t / (A + t) = 1) simp only [smul_eq_mul, log_one, mul_zero, zero_add, log_exp] at hc have he : (1 - t / (A + t)) * 1 + (t / (A + t)) * exp eta = (A + t * exp eta) / (A + t) := by field_simp; ring rw [he] at hc simpa only [div_eq_mul_inv, mul_assoc, mul_comm, mul_left_comm] using hc theorem shifted_exp_log_upper {A t eta : ℝ} (hA : 0 ≤ A) (ht : 0 < t) (heta : 0 ≤ eta) : log ((A + t * exp eta) / (A + t)) ≤ eta := by have he : 1 ≤ exp eta := one_le_exp_iff.mpr heta have hr : (A + t * exp eta) / (A + t) ≤ exp eta := by apply (div_le_iff₀ (by positivity : 0 < A + t)).mpr nlinarith simpa only [log_exp] using log_le_log (by positivity) hr noncomputable def coreSuffixPrimeBand (A B eta : ℝ) (j : ℕ) : Finset ℕ := primeLogWindow (A + B * 2 ^ j) (A + B * exp eta * 2 ^ j) theorem coreSuffixPrimeBand_subset {A B eta : ℝ} (hB : 0 < B) (heta : eta ≤ log 2) (j : ℕ) : coreSuffixPrimeBand A B eta j ⊆ virtualPrimeBand A B j := by intro p hp obtain ⟨hp, hlo, hhi⟩ := mem_primeLogWindow.mp hp have he : exp eta ≤ 2 := by simpa only [exp_log (by norm_num : (0 : ℝ) < 2)] using exp_le_exp.mpr heta apply mem_primeLogWindow.mpr refine ⟨hp, hlo, hhi.trans ?_⟩ rw [pow_succ] have ht : 0 ≤ B * (2 : ℝ) ^ j := by positivity nlinarith theorem prime_intensity_window_eq_normalized {lam : ℝ} (hlam : 0 < lam) (u v : ℝ) : (∑ p ∈ primeLogWindow u v, primeLogOddsIntensity lam p) = lam * primeNormalizedLogOddsWindowMass lam u v := by unfold primeNormalizedLogOddsWindowMass rw [mul_sum] apply sum_congr rfl intro p _ field_simp /-- Quantitative error before imposing a minimum width. -/ theorem coreSuffix_intensity_lower_error {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (heta : 0 ≤ eta) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (j : ℕ) : lam * (eta * B * 2 ^ j / (A + B * 2 ^ j) - 2 * primeLogOddsErrorConstant / (A + B * 2 ^ j)) ≤ ∑ p ∈ coreSuffixPrimeBand A B eta j, primeLogOddsIntensity lam p := by have hp : (1 : ℝ) ≤ 2 ^ j := one_le_pow₀ (by norm_num) have he : 1 ≤ exp eta := one_le_exp_iff.mpr heta have hu : log 2 ≤ A + B * 2 ^ j := by nlinarith have huv : A + B * 2 ^ j ≤ A + B * exp eta * 2 ^ j := by have ht : 0 ≤ B * (2 : ℝ) ^ j := by positivity nlinarith have hm := (abs_le.mp (primeNormalizedLogOddsWindowMass_estimate hlam hlam2 hu huv)).1 have hl := shifted_exp_log_lower hA (by positivity : 0 < B * (2 : ℝ) ^ j) eta have hl' : eta * B * 2 ^ j / (A + B * 2 ^ j) ≤ log ((A + B * exp eta * 2 ^ j) / (A + B * 2 ^ j)) := by simpa only [mul_assoc, mul_comm, mul_left_comm] using hl rw [coreSuffixPrimeBand, prime_intensity_window_eq_normalized (by linarith : 0 < lam)] apply mul_le_mul_of_nonneg_left _ (by linarith : 0 ≤ lam) linarith theorem coreSuffix_intensity_lower {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (heta : 0 < eta) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ eta * B) (j : ℕ) : lam * eta * B * 2 ^ j / (2 * (A + B * 2 ^ j)) ≤ ∑ p ∈ coreSuffixPrimeBand A B eta j, primeLogOddsIntensity lam p := by have hp : (1 : ℝ) ≤ 2 ^ j := one_le_pow₀ (by norm_num) have hd : 0 < A + B * 2 ^ j := by positivity have he : 4 * primeLogOddsErrorConstant ≤ eta * B * 2 ^ j := by apply hlarge.trans simpa only [mul_one] using mul_le_mul_of_nonneg_left hp (mul_pos heta hB).le apply le_trans _ (coreSuffix_intensity_lower_error hA hB hbase heta.le hlam hlam2 j) have herr : 2 * primeLogOddsErrorConstant / (A + B * 2 ^ j) ≤ eta * B * 2 ^ j / (2 * (A + B * 2 ^ j)) := by apply (div_le_div_iff₀ hd (by positivity)).mpr nlinarith have heq : eta * B * 2 ^ j / (A + B * 2 ^ j) = 2 * (eta * B * 2 ^ j / (2 * (A + B * 2 ^ j))) := by field_simp have hi : eta * B * 2 ^ j / (2 * (A + B * 2 ^ j)) ≤ eta * B * 2 ^ j / (A + B * 2 ^ j) - 2 * primeLogOddsErrorConstant / (A + B * 2 ^ j) := by linarith calc _ = lam * (eta * B * 2 ^ j / (2 * (A + B * 2 ^ j))) := by ring _ ≤ _ := mul_le_mul_of_nonneg_left hi (by linarith) theorem virtualPrime_intensity_upper_error {A B lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (j : ℕ) : (∑ p ∈ virtualPrimeBand A B j, primeLogOddsIntensity lam p) ≤ lam * (log 2 + 2 * primeLogOddsErrorConstant / (A + B * 2 ^ j)) := by have hp : (1 : ℝ) ≤ 2 ^ j := one_le_pow₀ (by norm_num) have hu : log 2 ≤ A + B * 2 ^ j := by nlinarith have huv : A + B * 2 ^ j ≤ A + B * 2 ^ (j + 1) := by rw [pow_succ]; nlinarith have hm := (abs_le.mp (primeNormalizedLogOddsWindowMass_estimate hlam hlam2 hu huv)).2 have hl : log ((A + B * 2 ^ (j + 1)) / (A + B * 2 ^ j)) ≤ log 2 := by simpa only [exp_log (by norm_num : (0 : ℝ) < 2), pow_succ, mul_assoc] using shifted_exp_log_upper hA (by positivity : 0 < B * (2 : ℝ) ^ j) (log_nonneg (by norm_num : (1 : ℝ) ≤ 2)) rw [virtualPrimeBand, prime_intensity_window_eq_normalized (by linarith : 0 < lam)] apply mul_le_mul_of_nonneg_left _ (by linarith : 0 ≤ lam) linarith /-- Exactly one prime is selected in the early segment, and none elsewhere in its full dyadic bin. Both the intensity and the void cost are explicit. -/ theorem coreSuffix_singleIn_probability_lower {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (heta : 0 < eta) (heta2 : eta ≤ log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ eta * B) (j : ℕ) : exp (-(lam * (log 2 + 2 * primeLogOddsErrorConstant / (A + B * 2 ^ j)))) * (lam * eta * B * 2 ^ j / (2 * (A + B * 2 ^ j))) ≤ primeTiltSingleInMass (virtualPrimeBand A B j) (coreSuffixPrimeBand A B eta j) lam := by have hL : 0 ≤ lam * eta * B * 2 ^ j / (2 * (A + B * 2 ^ j)) := by positivity have hmu := coreSuffix_intensity_lower hA hB hbase heta hlam hlam2 hlarge j have hempty := exp_le_exp.mpr (neg_le_neg (virtualPrime_intensity_upper_error hA hB hbase hlam hlam2 j)) calc _ ≤ exp (-(∑ p ∈ virtualPrimeBand A B j, primeLogOddsIntensity lam p)) * (lam * eta * B * 2 ^ j / (2 * (A + B * 2 ^ j))) := mul_le_mul_of_nonneg_right hempty hL _ ≤ exp (-(∑ p ∈ virtualPrimeBand A B j, primeLogOddsIntensity lam p)) * (∑ p ∈ coreSuffixPrimeBand A B eta j, primeLogOddsIntensity lam p) := mul_le_mul_of_nonneg_left hmu (exp_pos _).le _ ≤ _ := primeTiltSingleInMass_intensity_lower (fun _ hp ↦ (mem_primeLogWindow.mp hp).1) (coreSuffixPrimeBand_subset hB heta2 j) (by linarith) /-- Product lower bound in the actual tilted subset law. Injective labels allow any finite family of suffix bins, including translated block suffixes. -/ theorem coreSuffix_family_probability_lower {ι : Type*} [Fintype ι] [DecidableEq ι] (label : ι → ℕ) (hinj : Function.Injective label) {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (heta : 0 < eta) (heta2 : eta ≤ log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ eta * B) : (∏ i, exp (-(lam * (log 2 + 2 * primeLogOddsErrorConstant / (A + B * 2 ^ label i)))) * (lam * eta * B * 2 ^ label i / (2 * (A + B * 2 ^ label i)))) ≤ ∑ T ∈ (primeBandUnion (fun i ↦ virtualPrimeBand A B (label i))).powerset.filter (fun T ↦ ∀ i, (T ∩ virtualPrimeBand A B (label i)).card = 1 ∧ T ∩ virtualPrimeBand A B (label i) ⊆ coreSuffixPrimeBand A B eta (label i)), primeTiltWeight (primeBandUnion (fun i ↦ virtualPrimeBand A B (label i))) lam T := by classical have hdis : Pairwise (fun i j ↦ Disjoint (virtualPrimeBand A B (label i)) (virtualPrimeBand A B (label j))) := fun _ _ hij ↦ virtualPrimeBand_disjoint hB (fun h ↦ hij (hinj h)) rw [prime_tilt_disjoint_singleIn_product (fun i ↦ virtualPrimeBand A B (label i)) (fun i ↦ coreSuffixPrimeBand A B eta (label i)) hdis] apply prod_le_prod · intro i _ positivity · intro i _ exact coreSuffix_singleIn_probability_lower hA hB hbase heta heta2 hlam hlam2 hlarge (label i) end Erdos859Verification end /- Inlined development module: PrimePairHoleFilling.lean -/ section /- An actual tilted two-prime selection performs one quadratic hole-filling step, with a fixed thickening accounting for the prime quantile displacement. -/ namespace Erdos859Verification open Finset Real MeasureTheory open scoped ENNReal /-- The zero-threshold case follows from almost-everywhere vanishing, so no positive missing-measure assumption is needed. -/ theorem nonnegative_half_success_probability {mu : Measure ℝ} [IsProbabilityMeasure mu] {H : ℝ → ℝ} (hH : Measurable H) (hH0 : ∀ x, 0 ≤ H x) (hHi : Integrable H mu) {R : ℝ} (hR : 0 ≤ R) (hmean : (∫ x, H x ∂mu) ≤ R / 2) : (1 : ℝ) / 2 ≤ mu.real {x | H x ≤ R} := by have hgood : MeasurableSet {x | H x ≤ R} := measurableSet_le hH measurable_const by_cases hzero : R = 0 · have hi0 : (∫ x, H x ∂mu) = 0 := by apply le_antisymm _ (integral_nonneg hH0) simpa only [hzero, zero_div] using hmean have hae := (integral_eq_zero_iff_of_nonneg hH0 hHi).mp hi0 have he : {x | H x ≤ R} ∈ ae mu := by filter_upwards [hae] with x hx simp only [hx, Pi.zero_apply, hzero, le_refl] have hp := (mem_ae_iff_prob_eq_one hgood).mp he simp only [Measure.real, hp, ENNReal.toReal_one] norm_num · have hRpos : 0 < R := lt_of_le_of_ne hR (Ne.symm hzero) have hm := mul_meas_ge_le_integral_of_nonneg (Filter.Eventually.of_forall hH0) hHi R have htail : mu.real {x | R ≤ H x} ≤ (1 : ℝ) / 2 := by nlinarith [hm.trans hmean] have hcomp : mu.real {x | H x ≤ R}ᶜ ≤ mu.real {x | R ≤ H x} := by apply measureReal_mono _ (measure_ne_top _ _) intro x hx change ¬ H x ≤ R at hx exact (lt_of_not_ge hx).le have hsum := probReal_add_probReal_compl (μ := mu) hgood linarith theorem translation_hole_filling_success_probability {A : Set ℝ} (hA : MeasurableSet A) {a b w : ℝ} (hw : 0 < w) {f : ℝ → ℝ} (hf : Measurable f) (hf0 : ∀ g, 0 ≤ f g) (hfsupp : ∀ g, g ∉ Set.Icc (-w) w → f g = 0) (hfbound : ∀ g, f g ≤ 2 / w) (hmass : (∫⁻ g : ℝ, ENNReal.ofReal (f g)) = 1) : (1 : ℝ) / 2 ≤ (translationShiftLaw f).real {g | remainingHoleMeasure A (Set.Icc (a + w) (b - w)) g ≤ 4 * (volume.real (Set.Icc a b \ A)) ^ 2 / w} := by let : IsProbabilityMeasure (translationShiftLaw f) := translationShiftLaw_isProbability f hmass have hmain := translation_hole_filling_withDensity hA hw hf hf0 hfsupp hfbound (a := a) (b := b) apply nonnegative_half_success_probability (measurable_remainingHoleMeasure hA measurableSet_Icc) (remainingHoleMeasure_nonneg _ _) hmain.1 (by positivity) convert hmain.2 using 1 ring theorem logUniformPair_hole_success_probability {A : Set ℝ} (hA : MeasurableSet A) {a b u w : ℝ} (hw : 0 < w) (hwu : w ≤ u) : (1 : ℝ) / 2 ≤ (translationShiftLaw (logUniformPairDensity u w)).real {g | remainingHoleMeasure A (Set.Icc (a + w) (b - w)) g ≤ 4 * (volume.real (Set.Icc a b \ A)) ^ 2 / w} := by have hf := logUniformPairDensity_properties hw hwu exact translation_hole_filling_success_probability hA hw hf.1 hf.2.1 hf.2.2.2.1 hf.2.2.2.2.1 hf.2.2.1 theorem union_translate_subset_thickened {A : Set ℝ} {x y e : ℝ} (he : 0 ≤ e) (hxy : |y - x| ≤ e) : A ∪ realTranslateSet A x ⊆ realSupportThickening A e ∪ realTranslateSet (realSupportThickening A e) y := by intro z hz rcases hz with hz | hz · exact Or.inl ⟨z, hz, by simpa only [sub_self, abs_zero] using he⟩ · apply Or.inr refine ⟨z - x, hz, ?_⟩ have hid : z - y - (z - x) = x - y := by ring rw [hid, abs_sub_comm] exact hxy theorem remainingHoleMeasure_thickened_shift_le {A I : Set ℝ} {x y e : ℝ} (he : 0 ≤ e) (hxy : |y - x| ≤ e) (hI : volume I ≠ ∞) : remainingHoleMeasure (realSupportThickening A e) I y ≤ remainingHoleMeasure A I x := by apply measureReal_mono _ (measure_ne_top_of_subset Set.sdiff_subset hI) exact Set.sdiff_subset_sdiff_right (union_translate_subset_thickened he hxy) theorem realSupportThickening_union_translate (A : Set ℝ) (y e : ℝ) : realSupportThickening (A ∪ realTranslateSet A y) e = realSupportThickening A e ∪ realTranslateSet (realSupportThickening A e) y := by ext z constructor · rintro ⟨a, ha | ha, hza⟩ · exact Or.inl ⟨a, ha, hza⟩ · apply Or.inr refine ⟨a - y, ha, ?_⟩ have hid : z - y - (a - y) = z - a := by ring rwa [hid] · rintro (⟨a, ha, hza⟩ | ⟨a, ha, hza⟩) · exact ⟨a, Or.inl ha, hza⟩ · refine ⟨a + y, Or.inr ?_, ?_⟩ · simpa only [realTranslateSet, Set.mem_preimage, add_sub_cancel_right] using ha · have hid : z - (a + y) = z - y - a := by ring rwa [hid] def PrimePairHoleFillingEvent (A I : Set ℝ) (e r : ℝ) (T : Finset ℕ) : Prop := ∃ p ∈ T, ∃ q ∈ T, volume.real (I \ realSupportThickening (A ∪ realTranslateSet A (log (p : ℝ) - log (q : ℝ))) e) ≤ r theorem primePairHoleFillingEvent_eq (A I : Set ℝ) (e r : ℝ) : PrimePairHoleFillingEvent A I e r = PrimeSubsetPairEvent {y | remainingHoleMeasure (realSupportThickening A e) I y ≤ r} := by funext T apply propext simp only [PrimePairHoleFillingEvent, PrimeSubsetPairEvent, realSupportThickening_union_translate, remainingHoleMeasure, Set.mem_ofPred_eq] /-- The probability of a successful actual count-two selection has an explicit positive lower bound whenever the duplicate loss is smaller than one half. -/ theorem primeTilt_two_prime_hole_filling {A : Set ℝ} (hA : IsCompact A) {a b lam u eps eta : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * primeLogOddsErrorConstant ≤ eps * u) (heta : 0 ≤ eta) (hmargin : eta ≤ (1 : ℝ) / 2 - 64 * exp (-u) / eps) : eta * exp (-5 * eps) * (eps / 4) ^ 2 / 2 ≤ ∑ T ∈ (primeLogWindow u ((1 + eps) * u)).powerset.filter (fun T ↦ T.card = 2 ∧ PrimePairHoleFillingEvent A (Set.Icc (a + eps * u) (b - eps * u)) (32 * primeLogOddsErrorConstant) (4 * (volume.real (Set.Icc a b \ A)) ^ 2 / (eps * u)) T), primeTiltWeight (primeLogWindow u ((1 + eps) * u)) lam T := by classical let I := Set.Icc (a + eps * u) (b - eps * u) let R := 4 * (volume.real (Set.Icc a b \ A)) ^ 2 / (eps * u) let E : Set ℝ := {x | remainingHoleMeasure A I x ≤ R} let G : Set ℝ := {y | remainingHoleMeasure (realSupportThickening A (32 * primeLogOddsErrorConstant)) I y ≤ R} have hE : MeasurableSet E := measurableSet_le (measurable_remainingHoleMeasure hA.measurableSet measurableSet_Icc) measurable_const have hG : MeasurableSet G := measurableSet_le (measurable_remainingHoleMeasure (measurableSet_realSupportThickening hA _) measurableSet_Icc) measurable_const have he : 0 ≤ 32 * primeLogOddsErrorConstant := mul_nonneg (by norm_num) primeLogOddsErrorConstant_pos.le have hrobust : ∀ x ∈ E, ∀ y, |y - x| ≤ 32 * primeLogOddsErrorConstant → y ∈ G := by intro x hx y hxy exact (remainingHoleMeasure_thickened_shift_le he hxy isCompact_Icc.measure_ne_top).trans hx have hu0 : 0 < u := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hu have hrho : (1 : ℝ) / 2 ≤ (translationShiftLaw (logUniformPairDensity u (eps * u)) E).toReal := logUniformPair_hole_success_probability hA.measurableSet (mul_pos heps hu0) (mul_le_of_le_one_left hu0.le heps1) have h := primeTilt_broad_robust_pair_lower hlam hlam2 hu heps heps1 hlarge hE hG hrobust hrho heta hmargin simpa only [primePairHoleFillingEvent_eq, G, I, R] using h theorem primeTilt_two_prime_hole_filling_mass_pos {A : Set ℝ} (hA : IsCompact A) {a b lam u eps : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * primeLogOddsErrorConstant ≤ eps * u) (hduplicate : 64 * exp (-u) / eps < (1 : ℝ) / 2) : 0 < ∑ T ∈ (primeLogWindow u ((1 + eps) * u)).powerset.filter (fun T ↦ T.card = 2 ∧ PrimePairHoleFillingEvent A (Set.Icc (a + eps * u) (b - eps * u)) (32 * primeLogOddsErrorConstant) (4 * (volume.real (Set.Icc a b \ A)) ^ 2 / (eps * u)) T), primeTiltWeight (primeLogWindow u ((1 + eps) * u)) lam T := by have heta : 0 < (1 : ℝ) / 2 - 64 * exp (-u) / eps := sub_pos.mpr hduplicate have h := primeTilt_two_prime_hole_filling (a := a) (b := b) hA hlam hlam2 hu heps heps1 hlarge heta.le le_rfl exact (by positivity : 0 < ((1 : ℝ) / 2 - 64 * exp (-u) / eps) * exp (-5 * eps) * (eps / 4) ^ 2 / 2).trans_le h end Erdos859Verification end /- Inlined development module: FordOrderedSimplex.lean -/ section /- Exact volumes of ordered cubes, including zero-dimensional simplices. The cube is decomposed into permutation chambers whose overlaps are null. -/ open MeasureTheory Set open scoped ENNReal namespace Erdos859Verification def fordOrderedSimplex (k : ℕ) (t : ℝ) : Set (Fin k → ℝ) := Icc (fun _ ↦ 0) (fun _ ↦ t) ∩ {x | Monotone x} def fordOrderedChamber {k : ℕ} (t : ℝ) (σ : Equiv.Perm (Fin k)) : Set (Fin k → ℝ) := (fun x ↦ x ∘ σ) ⁻¹' fordOrderedSimplex k t theorem fordOrderedSimplex_measurable (k : ℕ) (t : ℝ) : MeasurableSet (fordOrderedSimplex k t) := measurableSet_Icc.inter isClosed_monotone.measurableSet theorem ford_permute_measurePreserving {k : ℕ} (σ : Equiv.Perm (Fin k)) : MeasurePreserving (fun x : Fin k → ℝ ↦ x ∘ σ) volume volume := by exact (volume_measurePreserving_piCongrLeft (fun _ : Fin k ↦ ℝ) σ).symm theorem fordOrderedChamber_measurable {k : ℕ} (t : ℝ) (σ : Equiv.Perm (Fin k)) : MeasurableSet (fordOrderedChamber t σ) := (fordOrderedSimplex_measurable k t).preimage (ford_permute_measurePreserving σ).measurable theorem fordOrderedChamber_volume {k : ℕ} (t : ℝ) (σ : Equiv.Perm (Fin k)) : volume (fordOrderedChamber t σ) = volume (fordOrderedSimplex k t) := (ford_permute_measurePreserving σ).measure_preimage (fordOrderedSimplex_measurable k t).nullMeasurableSet /-- Equal distinct coordinates form a proper linear subspace, hence a null set. -/ theorem ford_coordinate_tie_null {k : ℕ} {i j : Fin k} (hij : i ≠ j) : volume {x : Fin k → ℝ | x i = x j} = 0 := by let f : (Fin k → ℝ) →ₗ[ℝ] ℝ := (LinearMap.proj i : (Fin k → ℝ) →ₗ[ℝ] ℝ) - LinearMap.proj j have hf : f.ker ≠ ⊤ := by intro htop have hmem : (Pi.single i 1 : Fin k → ℝ) ∈ f.ker := by rw [htop]; trivial have hzero : f (Pi.single i 1) = 0 := hmem simp [f, hij.symm] at hzero have hset : {x : Fin k → ℝ | x i = x j} = (f.ker : Set (Fin k → ℝ)) := by ext x simp [f, sub_eq_zero] rw [hset] exact Measure.addHaar_submodule (volume : Measure (Fin k → ℝ)) f.ker hf theorem fordOrderedChamber_pairwise_aedisjoint (k : ℕ) (t : ℝ) : Pairwise (fun σ τ : Equiv.Perm (Fin k) ↦ AEDisjoint volume (fordOrderedChamber t σ) (fordOrderedChamber t τ)) := by intro σ τ hne obtain ⟨i, hi⟩ : ∃ i, σ i ≠ τ i := by by_contra! h exact hne (Equiv.ext h) apply measure_mono_null _ (ford_coordinate_tie_null hi) intro x hx have hmσ : Monotone (x ∘ σ) := hx.1.2 have hmτ : Monotone (x ∘ τ) := hx.2.2 exact congrFun (Tuple.unique_monotone hmσ hmτ) i theorem fordOrderedChamber_iUnion (k : ℕ) (t : ℝ) : (⋃ σ : Equiv.Perm (Fin k), fordOrderedChamber t σ) = Icc (fun _ : Fin k ↦ (0 : ℝ)) (fun _ ↦ t) := by ext x constructor · intro hx obtain ⟨σ, hσ⟩ := mem_iUnion.mp hx constructor · intro i simpa only [Function.comp_apply, Equiv.apply_symm_apply] using hσ.1.1 (σ.symm i) · intro i simpa only [Function.comp_apply, Equiv.apply_symm_apply] using hσ.1.2 (σ.symm i) · intro hx refine mem_iUnion.mpr ⟨Tuple.sort x, ?_⟩ exact ⟨⟨fun i ↦ hx.1 _, fun i ↦ hx.2 _⟩, Tuple.monotone_sort x⟩ /-- Each of the `k!` ordered chambers has the same volume, and together they form the cube. -/ theorem fordOrderedSimplex_volume_mul_factorial (k : ℕ) (t : ℝ) : (k.factorial : ℝ≥0∞) * volume (fordOrderedSimplex k t) = ENNReal.ofReal t ^ k := by have h := measure_iUnion₀ (fordOrderedChamber_pairwise_aedisjoint k t) (fun σ ↦ (fordOrderedChamber_measurable t σ).nullMeasurableSet) rw [fordOrderedChamber_iUnion] at h simp only [fordOrderedChamber_volume, tsum_fintype, Finset.sum_const, Finset.card_univ, Fintype.card_perm, Fintype.card_fin, nsmul_eq_mul] at h rw [Real.volume_Icc_pi] at h simpa only [sub_zero, Finset.prod_const, Finset.card_univ, Fintype.card_fin] using h.symm /-- The ordered simplex has its exact factorial volume, with no probabilistic assumptions. -/ theorem fordOrderedSimplex_volume (k : ℕ) {t : ℝ} (ht : 0 ≤ t) : volume (fordOrderedSimplex k t) = ENNReal.ofReal (t ^ k / (k.factorial : ℝ)) := by have hfac : (k.factorial : ℝ≥0∞) ≠ 0 := by exact_mod_cast k.factorial_ne_zero rw [ENNReal.ofReal_div_of_pos (by positivity : (0 : ℝ) < k.factorial), ENNReal.ofReal_pow ht, ENNReal.ofReal_natCast] exact (ENNReal.eq_div_iff hfac (by finiteness)).mpr (fordOrderedSimplex_volume_mul_factorial k t) end Erdos859Verification end /- Inlined development module: FordSupportInsertion.lean -/ section /- Inserting one logarithmic mark doubles support length at most. -/ open Finset Real MeasureTheory namespace Erdos859Verification theorem primeSubsetSumSupport_insert_cover (T : Finset ℕ) (p : ℕ) (d : ℝ) : primeSubsetSumSupport (insert p T) d ⊆ primeSubsetSumSupport T d ∪ (fun x : ℝ ↦ log (p : ℝ) + x) '' primeSubsetSumSupport T d := by intro y hy obtain ⟨U, hU, hy⟩ := mem_primeSubsetSumSupport.mp hy by_cases hp : p ∈ U · right have herase : U.erase p ⊆ T := by intro q hq have hqp := (mem_erase.mp hq).1 exact (mem_insert.mp (hU (mem_erase.mp hq).2)).resolve_left hqp have hsum := sum_erase_add U (fun q ↦ log (q : ℝ)) hp refine ⟨y - log (p : ℝ), mem_primeSubsetSumSupport.mpr ⟨U.erase p, herase, ?_⟩, by ring⟩ exact ⟨by linarith [hy.1], by linarith [hy.2]⟩ · left exact mem_primeSubsetSumSupport.mpr ⟨U, fun q hq ↦ (mem_insert.mp (hU hq)).resolve_left (by intro hqp subst q exact hp hq), hy⟩ theorem primeSubsetSumSupport_measure_insert_le (T : Finset ℕ) (p : ℕ) (d : ℝ) : volume.real (primeSubsetSumSupport (insert p T) d) ≤ 2 * volume.real (primeSubsetSumSupport T d) := by have hcompact : IsCompact (primeSubsetSumSupport T d ∪ (fun x : ℝ ↦ log (p : ℝ) + x) '' primeSubsetSumSupport T d) := (isCompact_primeSubsetSumSupport T d).union ((isCompact_primeSubsetSumSupport T d).image (continuous_const.add continuous_id)) have htranslate : volume.real ((fun x : ℝ ↦ log (p : ℝ) + x) '' primeSubsetSumSupport T d) = volume.real (primeSubsetSumSupport T d) := by simp only [Measure.real, Set.image_add_left, measure_preimage_add] calc _ ≤ volume.real (primeSubsetSumSupport T d ∪ (fun x : ℝ ↦ log (p : ℝ) + x) '' primeSubsetSumSupport T d) := measureReal_mono (primeSubsetSumSupport_insert_cover T p d) hcompact.measure_ne_top _ ≤ volume.real (primeSubsetSumSupport T d) + volume.real ((fun x : ℝ ↦ log (p : ℝ) + x) '' primeSubsetSumSupport T d) := measureReal_union_le _ _ _ = _ := by rw [htranslate]; ring end Erdos859Verification end /- Inlined development module: FiniteInsertionDomination.lean -/ section /- Product-moment domination from a pointwise insertion-growth bound. -/ open Finset Real namespace Erdos859Verification noncomputable def insertionWeightedSum {α : Type*} (P : Finset α) (w : α → ℝ) (f : Finset α → ℝ) : ℝ := ∑ S ∈ P.powerset, (∏ p ∈ S, w p) * f S theorem insertionWeightedSum_nonneg {α : Type*} (P : Finset α) {w : α → ℝ} {f : Finset α → ℝ} (hw : ∀ p, 0 ≤ w p) (hf : ∀ S, 0 ≤ f S) : 0 ≤ insertionWeightedSum P w f := sum_nonneg fun S _ ↦ mul_nonneg (prod_nonneg fun p _ ↦ hw p) (hf S) theorem insertionWeightedSum_mono {α : Type*} (P : Finset α) {w : α → ℝ} {f g : Finset α → ℝ} (hw : ∀ p, 0 ≤ w p) (hfg : ∀ S, f S ≤ g S) : insertionWeightedSum P w f ≤ insertionWeightedSum P w g := sum_le_sum fun S _ ↦ mul_le_mul_of_nonneg_left (hfg S) (prod_nonneg fun p _ ↦ hw p) theorem insertionWeightedSum_const_mul {α : Type*} (P : Finset α) (w : α → ℝ) (f : Finset α → ℝ) (c : ℝ) : insertionWeightedSum P w (fun S ↦ c * f S) = c * insertionWeightedSum P w f := by unfold insertionWeightedSum rw [mul_sum] apply sum_congr rfl intro S _ ring theorem insertionWeightedSum_insert {α : Type*} [DecidableEq α] {P : Finset α} {p : α} (hp : p ∉ P) (w : α → ℝ) (f : Finset α → ℝ) : insertionWeightedSum (insert p P) w f = insertionWeightedSum P w (fun S ↦ f S + w p * f (insert p S)) := by unfold insertionWeightedSum rw [sum_powerset_insert hp, ← sum_add_distrib] apply sum_congr rfl intro S hS rw [prod_insert (notMem_mono (mem_powerset.mp hS) hp)] ring theorem insertion_growth_one_coordinate {a b c w z : ℝ} (hw : 0 ≤ w) (hc : 0 ≤ c) (hz : 1 ≤ z) (hba : b ≤ c * a) : a + w * z * b ≤ ((1 + c * w * z) / (1 + c * w)) * (a + w * b) := by have hd : 0 < 1 + c * w := by positivity have hprod : 0 ≤ w * (z - 1) * (c * a - b) := mul_nonneg (mul_nonneg hw (sub_nonneg.mpr hz)) (sub_nonneg.mpr hba) rw [div_mul_eq_mul_div] apply (le_div_iff₀ hd).mpr nlinarith only [hprod] /-- A nonnegative set weight whose insertion cost is at most `c` is dominated, for increasing product moments, by independent selection with odds `c*w`. The statement does not divide by the total weight and includes zero mass. -/ theorem insertionWeightedSum_product_domination {α : Type*} [DecidableEq α] (P : Finset α) (w z : α → ℝ) {c : ℝ} (hc : 0 ≤ c) (hw : ∀ p, 0 ≤ w p) (hz : ∀ p, 1 ≤ z p) (f : Finset α → ℝ) (hf : ∀ S, 0 ≤ f S) (hgrowth : ∀ S p, f (insert p S) ≤ c * f S) : insertionWeightedSum P (fun p ↦ w p * z p) f ≤ insertionWeightedSum P w f * ∏ p ∈ P, (1 + c * w p * z p) / (1 + c * w p) := by induction P using Finset.induction_on generalizing f with | empty => simp [insertionWeightedSum] | @insert p P hp ih => let g : Finset α → ℝ := fun S ↦ f S + w p * f (insert p S) have hg0 : ∀ S, 0 ≤ g S := fun S ↦ add_nonneg (hf S) (mul_nonneg (hw p) (hf _)) have hg : ∀ S q, g (insert q S) ≤ c * g S := by intro S q have h1 := hgrowth S q have h2 := hgrowth (insert p S) q rw [insert_comm q p] at h2 dsimp [g] nlinarith [mul_le_mul_of_nonneg_left h2 (hw p)] have hfactor : 0 ≤ (1 + c * w p * z p) / (1 + c * w p) := by apply div_nonneg · exact add_nonneg zero_le_one (mul_nonneg (mul_nonneg hc (hw p)) (le_trans zero_le_one (hz p))) · exact add_nonneg zero_le_one (mul_nonneg hc (hw p)) calc _ = insertionWeightedSum P (fun q ↦ w q * z q) (fun S ↦ f S + w p * z p * f (insert p S)) := insertionWeightedSum_insert hp _ _ _ ≤ insertionWeightedSum P (fun q ↦ w q * z q) (fun S ↦ ((1 + c * w p * z p) / (1 + c * w p)) * g S) := by apply insertionWeightedSum_mono P (fun q ↦ mul_nonneg (hw q) (le_trans zero_le_one (hz q))) intro S exact insertion_growth_one_coordinate (hw p) hc (hz p) (hgrowth S p) _ = ((1 + c * w p * z p) / (1 + c * w p)) * insertionWeightedSum P (fun q ↦ w q * z q) g := insertionWeightedSum_const_mul _ _ _ _ _ ≤ ((1 + c * w p * z p) / (1 + c * w p)) * (insertionWeightedSum P w g * ∏ q ∈ P, (1 + c * w q * z q) / (1 + c * w q)) := mul_le_mul_of_nonneg_left (ih g hg0 hg) hfactor _ = _ := by rw [prod_insert hp, insertionWeightedSum_insert hp] dsimp [g] ring end Erdos859Verification end /- Inlined development module: FiniteInsertionMoments.lean -/ section /- Explicit exponential and polynomial moments for insertion-bounded weights. -/ open Finset Real namespace Erdos859Verification theorem insertion_exp_chord {v : ℝ} (hv : 0 ≤ v) (hv1 : v ≤ 1) : exp v - 1 ≤ (exp 1 - 1) * v := by have h := convexOn_exp.2 (Set.mem_univ (0 : ℝ)) (Set.mem_univ (1 : ℝ)) (sub_nonneg.mpr hv1) hv (show (1 - v) + v = 1 by ring) simp only [smul_eq_mul, mul_zero, zero_add, mul_one, exp_zero] at h linarith theorem insertion_exp_factor_le {c w v : ℝ} (hc : 0 ≤ c) (hw : 0 ≤ w) (hv : 0 ≤ v) (hv1 : v ≤ 1) : (1 + c * w * exp v) / (1 + c * w) ≤ exp (c * (exp 1 - 1) * w * v) := by have ht := insertion_exp_chord hv hv1 have he : 0 ≤ exp 1 - 1 := sub_nonneg.mpr (one_le_exp (by norm_num)) have hd : 0 < 1 + c * w := by positivity calc _ ≤ 1 + c * (exp 1 - 1) * w * v := by apply (div_le_iff₀ hd).mpr have hmul := mul_le_mul_of_nonneg_left ht (mul_nonneg hc hw) have hquadratic : 0 ≤ c * (exp 1 - 1) * w * v * (c * w) := by positivity nlinarith only [hmul, hquadratic] _ ≤ _ := by simpa only [add_comm] using add_one_le_exp (c * (exp 1 - 1) * w * v) theorem insertionWeightedSum_exp_identity {α : Type*} (P : Finset α) (w v : α → ℝ) (f : Finset α → ℝ) : insertionWeightedSum P w (fun S ↦ f S * exp (∑ p ∈ S, v p)) = insertionWeightedSum P (fun p ↦ w p * exp (v p)) f := by unfold insertionWeightedSum apply sum_congr rfl intro S _ dsimp only rw [exp_sum, prod_mul_distrib] ring /-- The total mass is retained on the right, so zero normalizers cause no exception. -/ theorem insertionWeightedSum_exp_moment {α : Type*} [DecidableEq α] (P : Finset α) (w v : α → ℝ) {c : ℝ} (hc : 0 ≤ c) (hw : ∀ p, 0 ≤ w p) (hv : ∀ p, 0 ≤ v p) (hv1 : ∀ p ∈ P, v p ≤ 1) (f : Finset α → ℝ) (hf : ∀ S, 0 ≤ f S) (hgrowth : ∀ S p, f (insert p S) ≤ c * f S) : insertionWeightedSum P w (fun S ↦ f S * exp (∑ p ∈ S, v p)) ≤ insertionWeightedSum P w f * exp (c * (exp 1 - 1) * ∑ p ∈ P, w p * v p) := by rw [insertionWeightedSum_exp_identity] apply (insertionWeightedSum_product_domination P w (fun p ↦ exp (v p)) hc hw (fun p ↦ one_le_exp (hv p)) f hf hgrowth).trans apply mul_le_mul_of_nonneg_left _ (insertionWeightedSum_nonneg P hw hf) calc _ ≤ ∏ p ∈ P, exp (c * (exp 1 - 1) * w p * v p) := by apply prod_le_prod · intro p _ exact div_nonneg (add_nonneg zero_le_one (mul_nonneg (mul_nonneg hc (hw p)) (exp_pos _).le)) (add_nonneg zero_le_one (mul_nonneg hc (hw p))) · intro p hp exact insertion_exp_factor_le hc (hw p) (hv p) (hv1 p hp) _ = _ := by rw [← exp_sum] congr 1 rw [mul_sum] apply sum_congr rfl intro p _ ring theorem insertionWeightedSum_power_moment {α : Type*} [DecidableEq α] (P : Finset α) (w v : α → ℝ) {c : ℝ} (hc : 0 ≤ c) (hw : ∀ p, 0 ≤ w p) (hv : ∀ p, 0 ≤ v p) (hv1 : ∀ p ∈ P, v p ≤ 1) (f : Finset α → ℝ) (hf : ∀ S, 0 ≤ f S) (hgrowth : ∀ S p, f (insert p S) ≤ c * f S) (r : ℕ) : insertionWeightedSum P w (fun S ↦ f S * (∑ p ∈ S, v p) ^ r) ≤ (r.factorial : ℝ) * insertionWeightedSum P w f * exp (c * (exp 1 - 1) * ∑ p ∈ P, w p * v p) := by have hfac : (0 : ℝ) < r.factorial := by exact_mod_cast Nat.factorial_pos r calc _ ≤ insertionWeightedSum P w (fun S ↦ (r.factorial : ℝ) * (f S * exp (∑ p ∈ S, v p))) := by apply insertionWeightedSum_mono P hw intro S have h := (div_le_iff₀ hfac).mp (pow_div_factorial_le_exp (∑ p ∈ S, v p) (sum_nonneg fun p _ ↦ hv p) r) have hm := mul_le_mul_of_nonneg_left h (hf S) nlinarith only [hm] _ = (r.factorial : ℝ) * insertionWeightedSum P w (fun S ↦ f S * exp (∑ p ∈ S, v p)) := insertionWeightedSum_const_mul _ _ _ _ _ ≤ _ := by simpa only [mul_assoc] using mul_le_mul_of_nonneg_left (insertionWeightedSum_exp_moment P w v hc hw hv hv1 f hf hgrowth) hfac.le end Erdos859Verification end /- Inlined development module: FordSupportMoments.lean -/ section /- Uniform logarithmic moments of the support-length weighted prime law. -/ open Finset Real MeasureTheory namespace Erdos859Verification /-- Natural subtraction makes the auxiliary weight nonnegative on every label. -/ noncomputable def fordPrimeOdds (p : ℕ) : ℝ := 1 / ((p - 1 : ℕ) : ℝ) theorem fordPrimeOdds_nonneg (p : ℕ) : 0 ≤ fordPrimeOdds p := by unfold fordPrimeOdds positivity theorem fordPrimeOdds_eq {p : ℕ} (hp : p.Prime) : fordPrimeOdds p = 1 / ((p : ℝ) - 1) := by unfold fordPrimeOdds rw [Nat.cast_sub hp.one_le, Nat.cast_one] theorem fordPrimeOdds_log_le {p : ℕ} (hp : p.Prime) : fordPrimeOdds p * log (p : ℝ) ≤ 2 * (log (p : ℝ) / p) := by have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le have hp0 : (0 : ℝ) < p := by positivity have hm : 0 < (p : ℝ) - 1 := by linarith have hl : 0 ≤ log (p : ℝ) := log_natCast_nonneg p rw [fordPrimeOdds_eq hp] have heq : (1 / ((p : ℝ) - 1)) * log (p : ℝ) = log (p : ℝ) / (p - 1) := by ring rw [heq, ← mul_div_assoc] apply (div_le_div_iff₀ hm hp0).mpr nlinarith theorem fordPrimeOdds_log_sum_le {P : Finset ℕ} {x : ℝ} (hx : 1 ≤ x) (hP : ∀ p ∈ P, p.Prime) (hPx : ∀ p ∈ P, (p : ℝ) ≤ x) : (∑ p ∈ P, fordPrimeOdds p * log (p : ℝ)) ≤ 2 * (log x + log 4 + 4) := by have hsub : P ⊆ (Ioc 0 ⌊x⌋₊).filter Nat.Prime := by intro p hp exact mem_filter.mpr ⟨mem_Ioc.mpr ⟨(hP p hp).pos, (Nat.le_floor_iff (by linarith : 0 ≤ x)).mpr (hPx p hp)⟩, hP p hp⟩ calc _ ≤ ∑ p ∈ P, 2 * (log (p : ℝ) / p) := sum_le_sum (fun p hp ↦ fordPrimeOdds_log_le (hP p hp)) _ ≤ ∑ p ∈ (Ioc 0 ⌊x⌋₊).filter Nat.Prime, 2 * (log (p : ℝ) / p) := sum_le_sum_of_subset_of_nonneg hsub (fun p _ _ ↦ mul_nonneg (by norm_num) (div_nonneg (log_natCast_nonneg p) (Nat.cast_nonneg p))) _ = 2 * (log x + PrimeMertens.E₁p x) := by rw [← mul_sum, PrimeMertens.sum_log_prime_div_eq] _ ≤ _ := by linarith [PrimeMertens.E₁p.le hx] noncomputable def fordLogMomentConstant : ℝ := 2 * (1 + (log 4 + 4) / log 2) theorem fordPrimeOdds_normalized_log_sum_le {P : Finset ℕ} {x : ℝ} (hx : 2 ≤ x) (hP : ∀ p ∈ P, p.Prime) (hPx : ∀ p ∈ P, (p : ℝ) ≤ x) : (∑ p ∈ P, fordPrimeOdds p * (log (p : ℝ) / log x)) ≤ fordLogMomentConstant := by have hl2 : 0 < log (2 : ℝ) := log_pos (by norm_num) have hlx : 0 < log x := log_pos (by linarith) have hle : log (2 : ℝ) ≤ log x := log_le_log (by norm_num) hx have hconst : 0 ≤ log (4 : ℝ) + 4 := by positivity calc _ = (∑ p ∈ P, fordPrimeOdds p * log (p : ℝ)) / log x := by rw [sum_div] apply sum_congr rfl intro p _ ring _ ≤ 2 * (log x + log 4 + 4) / log x := div_le_div_of_nonneg_right (fordPrimeOdds_log_sum_le (by linarith) hP hPx) hlx.le _ = 2 * (1 + (log 4 + 4) / log x) := by field_simp; ring _ ≤ _ := by unfold fordLogMomentConstant exact mul_le_mul_of_nonneg_left (add_le_add le_rfl (div_le_div_of_nonneg_left hconst hl2 hle)) (by norm_num) /-- Uniform moments for support-length weights, with explicit constants and no normalization or lower bound on support length. -/ theorem fordSupport_normalized_log_moment {P : Finset ℕ} {x : ℝ} (hx : 2 ≤ x) (hP : ∀ p ∈ P, p.Prime) (hPx : ∀ p ∈ P, (p : ℝ) ≤ x) (d : ℝ) (r : ℕ) : insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d) * (∑ p ∈ S, log (p : ℝ) / log x) ^ r) ≤ (r.factorial : ℝ) * insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) * exp (2 * (exp 1 - 1) * fordLogMomentConstant) := by have hlx : 0 < log x := log_pos (by linarith) have hf : ∀ S : Finset ℕ, 0 ≤ volume.real (primeSubsetSumSupport S d) := fun _ ↦ measureReal_nonneg have h := insertionWeightedSum_power_moment P fordPrimeOdds (fun p ↦ log (p : ℝ) / log x) (by norm_num : (0 : ℝ) ≤ 2) fordPrimeOdds_nonneg (fun p ↦ div_nonneg (log_natCast_nonneg p) hlx.le) (fun p hp ↦ (div_le_one hlx).mpr (log_le_log (by exact_mod_cast (hP p hp).pos) (hPx p hp))) (fun S ↦ volume.real (primeSubsetSumSupport S d)) hf (fun S p ↦ primeSubsetSumSupport_measure_insert_le S p d) r apply h.trans apply mul_le_mul_of_nonneg_left · apply exp_le_exp.mpr apply mul_le_mul_of_nonneg_left (fordPrimeOdds_normalized_log_sum_le hx hP hPx) exact mul_nonneg (by norm_num) (sub_nonneg.mpr (one_le_exp (by norm_num))) · exact mul_nonneg (Nat.cast_nonneg _) (insertionWeightedSum_nonneg P fordPrimeOdds_nonneg hf) theorem fordSupport_log_fourth_moment {P : Finset ℕ} {x : ℝ} (hx : 2 ≤ x) (hP : ∀ p ∈ P, p.Prime) (hPx : ∀ p ∈ P, (p : ℝ) ≤ x) (d : ℝ) : insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d) * (∑ p ∈ S, log (p : ℝ)) ^ 4) ≤ (24 * exp (2 * (exp 1 - 1) * fordLogMomentConstant)) * (log x) ^ 4 * insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) := by have hlx : log x ≠ 0 := (log_pos (by linarith : 1 < x)).ne' have hid : insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d) * (∑ p ∈ S, log (p : ℝ)) ^ 4) = (log x) ^ 4 * insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d) * (∑ p ∈ S, log (p : ℝ) / log x) ^ 4) := by rw [← insertionWeightedSum_const_mul] unfold insertionWeightedSum apply sum_congr rfl intro S _ dsimp only rw [← sum_div] field_simp rw [hid] have h := mul_le_mul_of_nonneg_left (fordSupport_normalized_log_moment hx hP hPx d 4) (pow_nonneg (log_nonneg (by linarith : 1 ≤ x)) 4) norm_num only [Nat.factorial, Nat.cast_mul, Nat.cast_ofNat, Nat.cast_one] at h nlinarith only [h] end Erdos859Verification end /- Inlined development module: FordLargestPrimeSplit.lean -/ section /- Exact largest-element decomposition and the weighted tail estimates. -/ open Finset Real MeasureTheory namespace Erdos859Verification theorem sum_powerset_by_largest {α : Type*} [LinearOrder α] (P : Finset α) (f : Finset α → ℝ) : (∑ S ∈ P.powerset, f S) = f ∅ + ∑ p ∈ P, ∑ R ∈ (P.filter (fun q ↦ q < p)).powerset, f (insert p R) := by induction P using Finset.induction_on_max with | empty => simp | insert p P hmax ih => have hp : p ∉ P := fun hp ↦ (lt_irrefl p) (hmax p hp) have hpfilter : (insert p P).filter (fun q ↦ q < p) = P := by ext q simp only [mem_filter, mem_insert] constructor · rintro ⟨rfl | hq, hlt⟩ · exact False.elim ((lt_irrefl _) hlt) · exact hq · intro hq exact ⟨Or.inr hq, hmax q hq⟩ have hqfilter (q : α) (hq : q ∈ P) : (insert p P).filter (fun r ↦ r < q) = P.filter (fun r ↦ r < q) := by rw [filter_insert, if_neg (not_lt.mpr (hmax q hq).le)] rw [sum_powerset_insert hp, ih, sum_insert hp, hpfilter] have heq : (∑ q ∈ P, ∑ R ∈ ((insert p P).filter (fun r ↦ r < q)).powerset, f (insert q R)) = ∑ q ∈ P, ∑ R ∈ (P.filter (fun r ↦ r < q)).powerset, f (insert q R) := sum_congr rfl fun q hq ↦ by rw [hqfilter q hq] rw [heq] ring theorem insertionWeightedSum_by_largest {α : Type*} [LinearOrder α] (P : Finset α) (w : α → ℝ) (f : Finset α → ℝ) : insertionWeightedSum P w f = f ∅ + ∑ p ∈ P, w p * insertionWeightedSum (P.filter (fun q ↦ q < p)) w (fun R ↦ f (insert p R)) := by unfold insertionWeightedSum rw [sum_powerset_by_largest] simp only [prod_empty, one_mul] congr 1 apply sum_congr rfl intro p _ rw [mul_sum] apply sum_congr rfl intro R hR have hp : p ∉ R := fun hp ↦ (lt_irrefl p) (mem_filter.mp ((mem_powerset.mp hR) hp)).2 rw [prod_insert hp] ring theorem insertionWeightedSum_universe_mono {α : Type*} {P Q : Finset α} (hPQ : P ⊆ Q) {w : α → ℝ} {f : Finset α → ℝ} (hw : ∀ p, 0 ≤ w p) (hf : ∀ S, 0 ≤ f S) : insertionWeightedSum P w f ≤ insertionWeightedSum Q w f := sum_le_sum_of_subset_of_nonneg (powerset_mono.mpr hPQ) (fun S _ _ ↦ mul_nonneg (prod_nonneg fun p _ ↦ hw p) (hf S)) theorem fordPrimeOdds_log_sq_sum_le {P : Finset ℕ} {x : ℝ} (hx : 2 ≤ x) (hP : ∀ p ∈ P, p.Prime) (hPx : ∀ p ∈ P, (p : ℝ) ≤ x) : (∑ p ∈ P, fordPrimeOdds p * (log (p : ℝ)) ^ 2) ≤ fordLogMomentConstant * (log x) ^ 2 := by have hlx : 0 < log x := log_pos (by linarith) have hsum := (fordPrimeOdds_normalized_log_sum_le hx hP hPx) have hid : (∑ p ∈ P, fordPrimeOdds p * (log (p : ℝ) / log x)) = (∑ p ∈ P, fordPrimeOdds p * log (p : ℝ)) / log x := by rw [sum_div] apply sum_congr rfl intro p _ ring rw [hid] at hsum have hbound := (div_le_iff₀ hlx).mp hsum calc _ ≤ ∑ p ∈ P, log x * (fordPrimeOdds p * log (p : ℝ)) := by apply sum_le_sum intro p hp have hlog := log_le_log (by exact_mod_cast (hP p hp).pos) (hPx p hp) have h := mul_le_mul_of_nonneg_right hlog (mul_nonneg (fordPrimeOdds_nonneg p) (log_natCast_nonneg p)) nlinarith only [h] _ = log x * ∑ p ∈ P, fordPrimeOdds p * log (p : ℝ) := (mul_sum _ _ _).symm _ ≤ log x * (fordLogMomentConstant * log x) := mul_le_mul_of_nonneg_left hbound hlx.le _ = _ := by ring theorem fordSupport_large_log_sum_mass {P : Finset ℕ} {x L : ℝ} (hx : 2 ≤ x) (hP : ∀ p ∈ P, p.Prime) (hPx : ∀ p ∈ P, (p : ℝ) ≤ x) (hL : 0 < L) (d : ℝ) : (∑ S ∈ P.powerset.filter (fun S : Finset ℕ ↦ L ≤ ∑ p ∈ S, log (p : ℝ)), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) ≤ (24 * exp (2 * (exp 1 - 1) * fordLogMomentConstant)) * (log x) ^ 4 / L ^ 4 * insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) := by classical have hmoment := fordSupport_log_fourth_moment hx hP hPx d have htail : (∑ S ∈ P.powerset.filter (fun S : Finset ℕ ↦ L ≤ ∑ p ∈ S, log (p : ℝ)), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) * L ^ 4 ≤ insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d) * (∑ p ∈ S, log (p : ℝ)) ^ 4) := by rw [sum_mul] unfold insertionWeightedSum apply (sum_le_sum (fun S hS ↦ ?_)).trans (sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun S _ _ ↦ ?_)) · have hw : 0 ≤ (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d) := mul_nonneg (prod_nonneg fun p _ ↦ fordPrimeOdds_nonneg p) measureReal_nonneg have h := mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hL.le (mem_filter.mp hS).2 4) hw simpa only [mul_assoc] using h · exact mul_nonneg (prod_nonneg fun p _ ↦ fordPrimeOdds_nonneg p) (mul_nonneg measureReal_nonneg (pow_nonneg (sum_nonneg fun p _ ↦ log_natCast_nonneg p) 4)) have h := (le_div_iff₀ (pow_pos hL 4)).mpr (htail.trans hmoment) simpa only [div_eq_mul_inv, mul_assoc, mul_comm, mul_left_comm] using h end Erdos859Verification end /- Inlined development module: FordDenominatorReduction.lean -/ section /- Removing a logarithmic denominator from support-weighted prime sums. -/ open Finset Real MeasureTheory namespace Erdos859Verification noncomputable def fordFourthMomentConstant : ℝ := 24 * exp (2 * (exp 1 - 1) * fordLogMomentConstant) theorem fordFourthMomentConstant_pos : 0 < fordFourthMomentConstant := by unfold fordFourthMomentConstant positivity theorem fordSupport_small_denominator_term {p : ℕ} (hp : p.Prime) {R : Finset ℕ} (hpR : p ∉ R) {D L : ℝ} (hDp : log (p : ℝ) ≤ D) (hDL : L ≤ D + ∑ q ∈ insert p R, log (q : ℝ)) (d : ℝ) : (if D < L / 4 then volume.real (primeSubsetSumSupport (insert p R) d) / D ^ 2 else 0) ≤ if L / 2 ≤ ∑ q ∈ R, log (q : ℝ) then 2 * volume.real (primeSubsetSumSupport R d) / (log (p : ℝ)) ^ 2 else 0 := by have hlp : 0 < log (p : ℝ) := log_pos (by exact_mod_cast hp.one_lt) have hD : 0 < D := hlp.trans_le hDp by_cases hsmall : D < L / 4 · have htail : L / 2 ≤ ∑ q ∈ R, log (q : ℝ) := by rw [sum_insert hpR] at hDL linarith rw [if_pos hsmall, if_pos htail] calc _ ≤ (2 * volume.real (primeSubsetSumSupport R d)) / D ^ 2 := div_le_div_of_nonneg_right (primeSubsetSumSupport_measure_insert_le R p d) (sq_nonneg D) _ ≤ _ := div_le_div_of_nonneg_left (mul_nonneg (by norm_num) measureReal_nonneg) (pow_pos hlp 2) (pow_le_pow_left₀ hlp.le hDp 2) · rw [if_neg hsmall] split_ifs <;> positivity theorem fordSupport_small_denominator_prefix {P : Finset ℕ} {p : ℕ} (hpP : p ∈ P) (hP : ∀ q ∈ P, q.Prime) {L : ℝ} (hL : 0 < L) (d : ℝ) (D : Finset ℕ → ℝ) (hDmark : ∀ S ⊆ P, ∀ q ∈ S, log (q : ℝ) ≤ D S) (hDsum : ∀ S ⊆ P, L ≤ D S + ∑ q ∈ S, log (q : ℝ)) : insertionWeightedSum (P.filter (fun q ↦ q < p)) fordPrimeOdds (fun R ↦ if D (insert p R) < L / 4 then volume.real (primeSubsetSumSupport (insert p R) d) / D (insert p R) ^ 2 else 0) ≤ 32 * fordFourthMomentConstant * (log (p : ℝ)) ^ 2 / L ^ 4 * insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) := by classical let Q := P.filter (fun q ↦ q < p) have hp : p.Prime := hP p hpP have hlp : 0 < log (p : ℝ) := log_pos (by exact_mod_cast hp.one_lt) have hQ : Q ⊆ P := filter_subset _ _ have hQprime : ∀ q ∈ Q, q.Prime := fun q hq ↦ hP q (hQ hq) have hQle : ∀ q ∈ Q, (q : ℝ) ≤ p := fun q hq ↦ by exact_mod_cast (mem_filter.mp hq).2.le have hZ : insertionWeightedSum Q fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) ≤ insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) := insertionWeightedSum_universe_mono hQ fordPrimeOdds_nonneg (fun _ ↦ measureReal_nonneg) have htail := fordSupport_large_log_sum_mass (by exact_mod_cast hp.two_le) hQprime hQle (by linarith : 0 < L / 2) d change (∑ S ∈ Q.powerset.filter (fun S : Finset ℕ ↦ L / 2 ≤ ∑ q ∈ S, log (q : ℝ)), (∏ q ∈ S, fordPrimeOdds q) * volume.real (primeSubsetSumSupport S d)) ≤ fordFourthMomentConstant * log (p : ℝ) ^ 4 / (L / 2) ^ 4 * insertionWeightedSum Q fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) at htail have hsum : insertionWeightedSum Q fordPrimeOdds (fun R ↦ if D (insert p R) < L / 4 then volume.real (primeSubsetSumSupport (insert p R) d) / D (insert p R) ^ 2 else 0) ≤ (2 / (log (p : ℝ)) ^ 2) * ∑ S ∈ Q.powerset.filter (fun S : Finset ℕ ↦ L / 2 ≤ ∑ q ∈ S, log (q : ℝ)), (∏ q ∈ S, fordPrimeOdds q) * volume.real (primeSubsetSumSupport S d) := by unfold insertionWeightedSum rw [sum_filter, mul_sum] apply sum_le_sum intro R hR have hRQ : R ⊆ Q := mem_powerset.mp hR have hpR : p ∉ R := fun hmem ↦ (lt_irrefl p) (mem_filter.mp (hRQ hmem)).2 have hSR : insert p R ⊆ P := insert_subset hpP (hRQ.trans hQ) have hterm := fordSupport_small_denominator_term hp hpR (hDmark _ hSR p (mem_insert_self _ _)) (hDsum _ hSR) d have hw : 0 ≤ ∏ q ∈ R, fordPrimeOdds q := prod_nonneg fun q _ ↦ fordPrimeOdds_nonneg q apply (mul_le_mul_of_nonneg_left hterm hw).trans_eq split_ifs <;> ring calc _ ≤ _ := hsum _ ≤ (2 / (log (p : ℝ)) ^ 2) * (fordFourthMomentConstant * log (p : ℝ) ^ 4 / (L / 2) ^ 4 * insertionWeightedSum Q fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d))) := mul_le_mul_of_nonneg_left htail (by positivity) _ ≤ (2 / (log (p : ℝ)) ^ 2) * (fordFourthMomentConstant * log (p : ℝ) ^ 4 / (L / 2) ^ 4 * insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d))) := by apply mul_le_mul_of_nonneg_left _ (by positivity) exact mul_le_mul_of_nonneg_left hZ (by have := fordFourthMomentConstant_pos positivity) _ = _ := by field_simp; ring theorem fordSupport_small_denominator_mass {P : Finset ℕ} {x : ℝ} (hx : 2 ≤ x) (hP : ∀ q ∈ P, q.Prime) (hPx : ∀ q ∈ P, (q : ℝ) ≤ x) (d : ℝ) (D : Finset ℕ → ℝ) (hDmark : ∀ S ⊆ P, ∀ q ∈ S, log (q : ℝ) ≤ D S) (hDsum : ∀ S ⊆ P, log x ≤ D S + ∑ q ∈ S, log (q : ℝ)) : insertionWeightedSum P fordPrimeOdds (fun S ↦ if D S < log x / 4 then volume.real (primeSubsetSumSupport S d) / D S ^ 2 else 0) ≤ (32 * fordFourthMomentConstant * fordLogMomentConstant / (log x) ^ 2) * insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) := by have hlx : 0 < log x := log_pos (by linarith) have hDempty : log x ≤ D ∅ := by simpa using hDsum ∅ (empty_subset P) have hempty : ¬ D ∅ < log x / 4 := by linarith have hZ : 0 ≤ insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) := insertionWeightedSum_nonneg P fordPrimeOdds_nonneg (fun _ ↦ measureReal_nonneg) calc _ = ∑ p ∈ P, fordPrimeOdds p * insertionWeightedSum (P.filter (fun q ↦ q < p)) fordPrimeOdds (fun R ↦ if D (insert p R) < log x / 4 then volume.real (primeSubsetSumSupport (insert p R) d) / D (insert p R) ^ 2 else 0) := by rw [insertionWeightedSum_by_largest] simp only [if_neg hempty, zero_add] _ ≤ ∑ p ∈ P, fordPrimeOdds p * (32 * fordFourthMomentConstant * (log (p : ℝ)) ^ 2 / (log x) ^ 4 * insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d))) := by apply sum_le_sum intro p hp exact mul_le_mul_of_nonneg_left (fordSupport_small_denominator_prefix hp hP hlx d D hDmark hDsum) (fordPrimeOdds_nonneg p) _ = (32 * fordFourthMomentConstant / (log x) ^ 4 * insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d))) * ∑ p ∈ P, fordPrimeOdds p * (log (p : ℝ)) ^ 2 := by rw [mul_sum] apply sum_congr rfl intro p _ ring _ ≤ (32 * fordFourthMomentConstant / (log x) ^ 4 * insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d))) * (fordLogMomentConstant * (log x) ^ 2) := by apply mul_le_mul_of_nonneg_left (fordPrimeOdds_log_sq_sum_le hx hP hPx) have := fordFourthMomentConstant_pos positivity _ = _ := by field_simp /-- A denominator controlling the largest selected log and the complement of the total selected log may be replaced by log(x), at a uniform constant cost. -/ theorem fordSupport_denominator_reduction {P : Finset ℕ} {x : ℝ} (hx : 2 ≤ x) (hP : ∀ q ∈ P, q.Prime) (hPx : ∀ q ∈ P, (q : ℝ) ≤ x) (d : ℝ) (D : Finset ℕ → ℝ) (hDmark : ∀ S ⊆ P, ∀ q ∈ S, log (q : ℝ) ≤ D S) (hDsum : ∀ S ⊆ P, log x ≤ D S + ∑ q ∈ S, log (q : ℝ)) : insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d) / D S ^ 2) ≤ ((16 + 32 * fordFourthMomentConstant * fordLogMomentConstant) / (log x) ^ 2) * insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) := by have hlx : 0 < log x := log_pos (by linarith) let f : Finset ℕ → ℝ := fun S ↦ volume.real (primeSubsetSumSupport S d) let bad : Finset ℕ → ℝ := fun S ↦ if D S < log x / 4 then f S / D S ^ 2 else 0 have hpoint (S : Finset ℕ) : f S / D S ^ 2 ≤ (16 / (log x) ^ 2) * f S + bad S := by have hf : 0 ≤ f S := measureReal_nonneg by_cases hsmall : D S < log x / 4 · simp only [bad, if_pos hsmall] have hnonneg : 0 ≤ (16 / (log x) ^ 2) * f S := by positivity linarith · have hD : log x / 4 ≤ D S := le_of_not_gt hsmall have hsq : (log x) ^ 2 / 16 ≤ D S ^ 2 := by nlinarith simp only [bad, if_neg hsmall, add_zero] calc _ ≤ f S / ((log x) ^ 2 / 16) := div_le_div_of_nonneg_left hf (by positivity) hsq _ = _ := by ring calc _ ≤ insertionWeightedSum P fordPrimeOdds (fun S ↦ (16 / (log x) ^ 2) * f S + bad S) := insertionWeightedSum_mono P fordPrimeOdds_nonneg hpoint _ = (16 / (log x) ^ 2) * insertionWeightedSum P fordPrimeOdds f + insertionWeightedSum P fordPrimeOdds bad := by unfold insertionWeightedSum simp only [mul_add, sum_add_distrib, mul_sum] congr 1 apply sum_congr rfl intro S _ ring _ ≤ (16 / (log x) ^ 2) * insertionWeightedSum P fordPrimeOdds f + (32 * fordFourthMomentConstant * fordLogMomentConstant / (log x) ^ 2) * insertionWeightedSum P fordPrimeOdds f := add_le_add le_rfl (fordSupport_small_denominator_mass hx hP hPx d D hDmark hDsum) _ = _ := by dsimp [f]; ring noncomputable def fordLogDenominator (x : ℝ) (S : Finset ℕ) : ℝ := log (((S.sup id : ℕ) : ℝ) + x / (∏ p ∈ S, (p : ℝ))) theorem fordLogDenominator_mark {P S : Finset ℕ} (hS : S ⊆ P) (hP : ∀ p ∈ P, p.Prime) {x : ℝ} (hx : 0 ≤ x) {p : ℕ} (hp : p ∈ S) : log (p : ℝ) ≤ fordLogDenominator x S := by have hprod : 0 < ∏ q ∈ S, (q : ℝ) := prod_pos fun q hq ↦ by exact_mod_cast (hP q (hS hq)).pos have hmax : (p : ℝ) ≤ ((S.sup id : ℕ) : ℝ) := by exact_mod_cast (Finset.le_sup (f := id) hp) apply log_le_log (by exact_mod_cast (hP p (hS hp)).pos) exact hmax.trans (le_add_of_nonneg_right (div_nonneg hx hprod.le)) theorem fordLogDenominator_sum {P S : Finset ℕ} (hS : S ⊆ P) (hP : ∀ p ∈ P, p.Prime) {x : ℝ} (hx : 0 < x) : log x ≤ fordLogDenominator x S + ∑ p ∈ S, log (p : ℝ) := by have hprod : 0 < ∏ q ∈ S, (q : ℝ) := prod_pos fun q hq ↦ by exact_mod_cast (hP q (hS hq)).pos have hlow : x / (∏ q ∈ S, (q : ℝ)) ≤ ((S.sup id : ℕ) : ℝ) + x / (∏ q ∈ S, (q : ℝ)) := le_add_of_nonneg_left (Nat.cast_nonneg _) have hlog := log_le_log (div_pos hx hprod) hlow rw [log_div hx.ne' hprod.ne', log_prod (fun q hq ↦ by exact_mod_cast (hP q (hS hq)).ne_zero)] at hlog change log x ≤ log (((S.sup id : ℕ) : ℝ) + x / (∏ q ∈ S, (q : ℝ))) + ∑ q ∈ S, log (q : ℝ) linarith /-- The logarithmic denominator in the largest-prime localization is now removed at an explicit uniform constant cost. -/ theorem fordSupport_actual_denominator_reduction {P : Finset ℕ} {x : ℝ} (hx : 2 ≤ x) (hP : ∀ p ∈ P, p.Prime) (hPx : ∀ p ∈ P, (p : ℝ) ≤ x) (d : ℝ) : insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d) / fordLogDenominator x S ^ 2) ≤ ((16 + 32 * fordFourthMomentConstant * fordLogMomentConstant) / (log x) ^ 2) * insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) := fordSupport_denominator_reduction hx hP hPx d (fordLogDenominator x) (fun _ hS _ hp ↦ fordLogDenominator_mark hS hP (by linarith) hp) (fun _ hS ↦ fordLogDenominator_sum hS hP (by linarith)) end Erdos859Verification end /- Inlined development module: CoreBlockEvent.lean -/ section /- One complete prefix-ballot and early-suffix block in the actual prime law. -/ namespace Erdos859Verification open Finset Real noncomputable def coreBlockBand (A B : ℝ) (n K : ℕ) : Option (Fin K) → Finset ℕ | none => virtualPrimeUniverse A B n | some j => virtualPrimeBand A B (n + j.val) def CoreBlockEvent (A B eta : ℝ) (n K : ℕ) (T : Finset ℕ) : Prop := (T ∩ virtualPrimeUniverse A B n).card = n ∧ primeSubsetBallot (virtualPrimeUniverse A B n) (virtualPrimeBinIndex A B n) (T ∩ virtualPrimeUniverse A B n) ∧ ∀ j : Fin K, (T ∩ virtualPrimeBand A B (n + j.val)).card = 1 ∧ T ∩ virtualPrimeBand A B (n + j.val) ⊆ coreSuffixPrimeBand A B eta (n + j.val) noncomputable def coreBlockEventMass (A B eta lam : ℝ) (n K : ℕ) : ℝ := by classical exact ∑ T ∈ (virtualPrimeUniverse A B (n + K)).powerset.filter (CoreBlockEvent A B eta n K), primeTiltWeight (virtualPrimeUniverse A B (n + K)) lam T theorem coreBlockBand_union (A B : ℝ) (n K : ℕ) : primeBandUnion (coreBlockBand A B n K) = virtualPrimeUniverse A B (n + K) := by ext p constructor · intro hp obtain ⟨j, _, hj⟩ := mem_biUnion.mp hp cases j with | none => obtain ⟨i, hi, hpi⟩ := mem_biUnion.mp hj exact mem_biUnion.mpr ⟨i, mem_range.mpr (by have := mem_range.mp hi; omega), hpi⟩ | some j => exact mem_biUnion.mpr ⟨n + j.val, mem_range.mpr (by omega), hj⟩ · intro hp obtain ⟨i, hi, hpi⟩ := mem_biUnion.mp hp by_cases hin : i < n · exact mem_biUnion.mpr ⟨none, mem_univ _, mem_biUnion.mpr ⟨i, mem_range.mpr hin, hpi⟩⟩ · have hK : i - n < K := by have := mem_range.mp hi; omega refine mem_biUnion.mpr ⟨some ⟨i - n, hK⟩, mem_univ _, ?_⟩ simpa only [coreBlockBand, Nat.add_sub_of_le (by omega : n ≤ i)] using hpi theorem virtualPrimeUniverse_disjoint_later_band {A B : ℝ} (hB : 0 < B) {n j : ℕ} (hnj : n ≤ j) : Disjoint (virtualPrimeUniverse A B n) (virtualPrimeBand A B j) := by apply disjoint_left.mpr intro p hp hj obtain ⟨i, hi, hpi⟩ := mem_biUnion.mp hp exact disjoint_left.mp (virtualPrimeBand_disjoint hB (by have := mem_range.mp hi; omega)) hpi hj theorem coreBlockBand_disjoint {A B : ℝ} (hB : 0 < B) (n K : ℕ) : Pairwise (fun i j ↦ Disjoint (coreBlockBand A B n K i) (coreBlockBand A B n K j)) := by intro i j hij cases i with | none => cases j with | none => exact False.elim (hij rfl) | some j => exact virtualPrimeUniverse_disjoint_later_band hB (Nat.le_add_right n j.val) | some i => cases j with | none => exact (virtualPrimeUniverse_disjoint_later_band hB (Nat.le_add_right n i.val)).symm | some j => apply virtualPrimeBand_disjoint hB intro h exact hij (congrArg some (Fin.ext (Nat.add_left_cancel h))) noncomputable def coreBlockBandEvent (A B eta : ℝ) (n K : ℕ) : Option (Fin K) → Finset ℕ → Prop | none, T => T.card = n ∧ primeSubsetBallot (virtualPrimeUniverse A B n) (virtualPrimeBinIndex A B n) T | some j, T => T.card = 1 ∧ T ⊆ coreSuffixPrimeBand A B eta (n + j.val) theorem coreBlockEvent_iff_band_events (A B eta : ℝ) (n K : ℕ) (T : Finset ℕ) : CoreBlockEvent A B eta n K T ↔ ∀ i, coreBlockBandEvent A B eta n K i (T ∩ coreBlockBand A B n K i) := by constructor · intro h i cases i with | none => exact ⟨h.1, h.2.1⟩ | some j => exact h.2.2 j · intro h exact ⟨(h none).1, (h none).2, fun j ↦ h (some j)⟩ theorem coreBlockEventMass_factorization {A B : ℝ} (hB : 0 < B) (eta lam : ℝ) (n K : ℕ) : coreBlockEventMass A B eta lam n K = virtualPrimeBallotMass A B lam n * ∏ j : Fin K, primeTiltSingleInMass (virtualPrimeBand A B (n + j.val)) (coreSuffixPrimeBand A B eta (n + j.val)) lam := by classical have h := prime_tilt_disjoint_band_events_product (coreBlockBand A B n K) (coreBlockBand_disjoint hB n K) lam (coreBlockBandEvent A B eta n K) simp_rw [← coreBlockEvent_iff_band_events] at h rw [coreBlockBand_union, Fintype.prod_option] at h have hpref : (∑ T ∈ (coreBlockBand A B n K none).powerset.filter (coreBlockBandEvent A B eta n K none), primeTiltWeight (coreBlockBand A B n K none) lam T) = virtualPrimeBallotMass A B lam n := by simp only [virtualPrimeBallotMass, primeTiltGoodCountMass, coreBlockBand, coreBlockBandEvent, sum_filter] apply sum_congr rfl intro T _ by_cases ht : T.card = n ∧ primeSubsetBallot (virtualPrimeUniverse A B n) (virtualPrimeBinIndex A B n) T · simp only [ht] · simp only [ht, if_false] have hsuff (j : Fin K) : (∑ T ∈ (coreBlockBand A B n K (some j)).powerset.filter (coreBlockBandEvent A B eta n K (some j)), primeTiltWeight (coreBlockBand A B n K (some j)) lam T) = primeTiltSingleInMass (virtualPrimeBand A B (n + j.val)) (coreSuffixPrimeBand A B eta (n + j.val)) lam := by simp only [primeTiltSingleInMass, coreBlockBand, coreBlockBandEvent, sum_filter] apply sum_congr rfl intro T _ by_cases ht : T.card = 1 ∧ T ⊆ coreSuffixPrimeBand A B eta (n + j.val) · simp only [ht] · simp only [ht, if_false] rw [hpref] at h simp_rw [hsuff] at h exact h theorem sum_primeBand_intersections {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) (hdis : Pairwise (fun i j ↦ Disjoint (P i) (P j))) {T : Finset ℕ} (hT : T ⊆ primeBandUnion P) (f : ℕ → ℝ) : (∑ p ∈ T, f p) = ∑ i, ∑ p ∈ T ∩ P i, f p := by rw [← primeBand_intersections_union P hT] rw [sum_biUnion (fun i _ j _ hij ↦ Disjoint.mono inter_subset_right inter_subset_right (hdis hij))] simp only [primeBand_union_inter hdis (fun _ ↦ inter_subset_right)] theorem coreBlockEvent_card {A B eta : ℝ} {n K : ℕ} {T : Finset ℕ} (hB : 0 < B) (hT : T ⊆ virtualPrimeUniverse A B (n + K)) (hevent : CoreBlockEvent A B eta n K T) : T.card = n + K := by have hsub : T ⊆ primeBandUnion (coreBlockBand A B n K) := by rwa [coreBlockBand_union] rw [card_primeBand_intersections (coreBlockBand A B n K) (coreBlockBand_disjoint hB n K) hsub, Fintype.sum_option] simp only [coreBlockBand, hevent.1, (hevent.2.2 _).1, sum_const, card_univ, Fintype.card_fin, smul_eq_mul, mul_one] theorem coreBlockEvent_log_sum_le {A B eta eps : ℝ} {n K : ℕ} {T : Finset ℕ} (hB : 0 < B) (hT : T ⊆ virtualPrimeUniverse A B (n + K)) (hevent : CoreBlockEvent A B eta n K T) (hsize : (n : ℝ) ≤ eps * (2 : ℝ) ^ K) : (∑ p ∈ T, log (p : ℝ)) ≤ (n + K : ℕ) * A + B * (exp eta + eps) * (2 : ℝ) ^ (n + K) := by have hprefix : (∑ p ∈ T ∩ virtualPrimeUniverse A B n, log (p : ℝ)) ≤ (n : ℝ) * (A + B * 2 ^ n) := by have hb : ∀ p ∈ T ∩ virtualPrimeUniverse A B n, log (p : ℝ) ≤ A + B * 2 ^ n := by intro p hp have hw := (mem_inter.mp hp).2 rw [virtualPrimeUniverse_eq_window hB] at hw exact (mem_primeLogWindow.mp hw).2.2 have hs := sum_le_sum (fun p hp ↦ hb p hp) simpa only [sum_const, nsmul_eq_mul, hevent.1] using hs have hsuffix (j : Fin K) : (∑ p ∈ T ∩ virtualPrimeBand A B (n + j.val), log (p : ℝ)) ≤ A + B * exp eta * 2 ^ (n + j.val) := by have hb : ∀ p ∈ T ∩ virtualPrimeBand A B (n + j.val), log (p : ℝ) ≤ A + B * exp eta * 2 ^ (n + j.val) := fun _ hp ↦ (mem_primeLogWindow.mp ((hevent.2.2 j).2 hp)).2.2 have hs := sum_le_sum (fun p hp ↦ hb p hp) simpa only [sum_const, nsmul_eq_mul, (hevent.2.2 j).1, Nat.cast_one, one_mul] using hs have hsub : T ⊆ primeBandUnion (coreBlockBand A B n K) := by rwa [coreBlockBand_union] have hsplit := sum_primeBand_intersections (coreBlockBand A B n K) (coreBlockBand_disjoint hB n K) hsub (fun p ↦ log (p : ℝ)) rw [Fintype.sum_option] at hsplit have hsum : (∑ j : Fin K, (A + B * exp eta * 2 ^ (n + (j : ℕ)))) = (K : ℝ) * A + B * exp eta * ((2 : ℝ) ^ (n + K) - (2 : ℝ) ^ n) := by rw [Fin.sum_univ_eq_sum_range (fun j : ℕ ↦ A + B * exp eta * 2 ^ (n + j)), sum_add_distrib, ← mul_sum, sum_shifted_dyadic_powers] simp have hpre : (n : ℝ) * (2 : ℝ) ^ n ≤ eps * (2 : ℝ) ^ (n + K) := by have h := mul_le_mul_of_nonneg_right hsize (by positivity : (0 : ℝ) ≤ 2 ^ n) simpa only [pow_add, mul_assoc, mul_comm, mul_left_comm] using h have hgeom : (n : ℝ) * (2 : ℝ) ^ n + exp eta * ((2 : ℝ) ^ (n + K) - (2 : ℝ) ^ n) ≤ (exp eta + eps) * (2 : ℝ) ^ (n + K) := by nlinarith [show 0 ≤ exp eta * (2 : ℝ) ^ n by positivity] calc _ = _ := hsplit _ ≤ (n : ℝ) * (A + B * 2 ^ n) + ∑ j : Fin K, (A + B * exp eta * 2 ^ (n + j.val)) := add_le_add hprefix (sum_le_sum (fun j _ ↦ hsuffix j)) _ = (n + K : ℕ) * A + B * ((n : ℝ) * (2 : ℝ) ^ n + exp eta * ((2 : ℝ) ^ (n + K) - (2 : ℝ) ^ n)) := by rw [hsum]; push_cast; ring _ ≤ _ := by simpa only [mul_assoc] using add_le_add le_rfl (mul_le_mul_of_nonneg_left hgeom hB.le) noncomputable def coreBlockSuffixLower (A B eta lam : ℝ) (n K : ℕ) : ℝ := ∏ j : Fin K, exp (-(lam * (log 2 + 2 * primeLogOddsErrorConstant / (A + B * 2 ^ (n + j.val))))) * (lam * eta * B * 2 ^ (n + j.val) / (2 * (A + B * 2 ^ (n + j.val)))) noncomputable def coreBlockPrefixLower (A B lam : ℝ) (n J : ℕ) : ℝ := exp (-(n : ℝ) * (lam * log 2 - 1 - log (lam * log 2)) - 2 * lam * primeLogOddsErrorConstant / (A + B) - J * log (1 + A / B) - 2 - 2 * n * virtualPrimeRelativeError B) / (exp 1 * (n : ℝ) ^ 2) - (8 * (n : ℝ) ^ 2 * (A + B) / (B * log 2)) * exp (-(A + B)) theorem virtualPrimeBallotMass_nonneg {A B lam : ℝ} (hB : 0 < B) (hlam : 0 < lam) (n : ℕ) : 0 ≤ virtualPrimeBallotMass A B lam n := by unfold virtualPrimeBallotMass primeTiltGoodCountMass apply sum_nonneg intro T _ exact (primeTiltWeight_pos (fun p hp ↦ by rw [virtualPrimeUniverse_eq_window hB] at hp exact (mem_primeLogWindow.mp hp).1) hlam T).le theorem coreBlockSuffixLower_nonneg {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (heta : 0 ≤ eta) (hlam : 0 ≤ lam) (n K : ℕ) : 0 ≤ coreBlockSuffixLower A B eta lam n K := by apply prod_nonneg intro j _ positivity theorem coreBlockEventMass_lower_of_prefix {A B eta lam L : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (heta : 0 < eta) (heta2 : eta ≤ log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ eta * B) (n K : ℕ) (hprefix : L ≤ virtualPrimeBallotMass A B lam n) : L * coreBlockSuffixLower A B eta lam n K ≤ coreBlockEventMass A B eta lam n K := by rw [coreBlockEventMass_factorization hB] apply mul_le_mul hprefix · apply prod_le_prod · intro j _ positivity · intro j _ exact coreSuffix_singleIn_probability_lower hA hB hbase heta heta2 hlam hlam2 hlarge (n + j.val) · exact coreBlockSuffixLower_nonneg hA hB heta.le (by linarith) n K · exact virtualPrimeBallotMass_nonneg hB (by linarith) n /-- Explicit finite lower bound; the prefix term retains its proved repeated-mark error, and taking its positive part requires no extra probability margin. -/ theorem coreBlockEventMass_explicit_lower {n : ℕ} (hn : 0 < n) (K : ℕ) {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (heta : 0 < eta) (heta2 : eta ≤ log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ eta * B) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) : max 0 (coreBlockPrefixLower A B lam n J) * coreBlockSuffixLower A B eta lam n K ≤ coreBlockEventMass A B eta lam n K := by have hlarge' : 4 * primeLogOddsErrorConstant ≤ B * log 2 := hlarge.trans (by simpa only [mul_comm] using mul_le_mul_of_nonneg_right heta2 hB.le) apply coreBlockEventMass_lower_of_prefix hA hB hbase heta heta2 hlam hlam2 hlarge n K exact max_le (virtualPrimeBallotMass_nonneg hB (by linarith) n) (virtualPrime_ballot_probability_explicit_lower hn hA hB hbase hlam hlam2 hlarge' hAB) end Erdos859Verification end /- Inlined development module: CoreMultiBlockEvent.lean -/ section /- Consecutive actual prime blocks, their exact law, and every endpoint anchor. -/ namespace Erdos859Verification open Finset Real noncomputable def coreMultiBlockBand (A B : ℝ) (h b : ℕ) : Finset ℕ := virtualPrimeUniverse A (B * 2 ^ (b * h)) h theorem coreMultiBlockBand_eq_window {A B : ℝ} (hB : 0 < B) (h b : ℕ) : coreMultiBlockBand A B h b = primeLogWindow (A + B * 2 ^ (b * h)) (A + B * 2 ^ ((b + 1) * h)) := by rw [coreMultiBlockBand, virtualPrimeUniverse_eq_window (by positivity : 0 < B * (2 : ℝ) ^ (b * h))] simp only [Nat.add_mul, one_mul, pow_add, mul_assoc] theorem coreMultiBlockBand_disjoint {A B : ℝ} (hB : 0 < B) (h : ℕ) : Pairwise (fun b c ↦ Disjoint (coreMultiBlockBand A B h b) (coreMultiBlockBand A B h c)) := by intro b c hbc rw [coreMultiBlockBand_eq_window hB, coreMultiBlockBand_eq_window hB] apply disjoint_left.mpr intro p hpb hpc obtain ⟨_, hb0, hb1⟩ := mem_primeLogWindow.mp hpb obtain ⟨_, hc0, hc1⟩ := mem_primeLogWindow.mp hpc rcases lt_or_gt_of_ne hbc with hbc | hcb · have hp : (2 : ℝ) ^ ((b + 1) * h) ≤ 2 ^ (c * h) := pow_le_pow_right₀ (by norm_num) (Nat.mul_le_mul_right h (by omega)) nlinarith · have hp : (2 : ℝ) ^ ((c + 1) * h) ≤ 2 ^ (b * h) := pow_le_pow_right₀ (by norm_num) (Nat.mul_le_mul_right h (by omega)) nlinarith theorem coreMultiBlockBand_union_range {A B : ℝ} (hB : 0 < B) (r h : ℕ) : (range r).biUnion (coreMultiBlockBand A B h) = virtualPrimeUniverse A B (r * h) := by induction r with | zero => simp [virtualPrimeUniverse] | succ r ih => rw [range_add_one, biUnion_insert, ih, union_comm] simp only [virtualPrimeUniverse_eq_window hB, coreMultiBlockBand_eq_window hB] apply primeLogWindow_union_adjacent · have hp : (1 : ℝ) ≤ 2 ^ (r * h) := one_le_pow₀ (by norm_num) nlinarith · have hp : (2 : ℝ) ^ (r * h) ≤ 2 ^ ((r + 1) * h) := pow_le_pow_right₀ (by norm_num) (Nat.mul_le_mul_right h (by omega)) nlinarith theorem coreMultiBlockBand_union {A B : ℝ} (hB : 0 < B) (r h : ℕ) : primeBandUnion (fun b : Fin r ↦ coreMultiBlockBand A B h b.val) = virtualPrimeUniverse A B (r * h) := by rw [← coreMultiBlockBand_union_range hB r h] ext p constructor · intro hp obtain ⟨b, _, hpb⟩ := mem_biUnion.mp hp exact mem_biUnion.mpr ⟨b.val, mem_range.mpr b.isLt, hpb⟩ · intro hp obtain ⟨b, hb, hpb⟩ := mem_biUnion.mp hp exact mem_biUnion.mpr ⟨⟨b, mem_range.mp hb⟩, mem_univ _, hpb⟩ theorem coreMultiBlockBand_subset_universe {A B : ℝ} (hB : 0 < B) {r b : ℕ} (hbr : b < r) (h : ℕ) : coreMultiBlockBand A B h b ⊆ virtualPrimeUniverse A B (r * h) := by rw [← coreMultiBlockBand_union_range hB] intro p hp exact mem_biUnion.mpr ⟨b, mem_range.mpr hbr, hp⟩ def CoreMultiBlockEvent (A B eta : ℝ) (n K r : ℕ) (T : Finset ℕ) : Prop := ∀ b : Fin r, CoreBlockEvent A (B * 2 ^ (b.val * (n + K))) eta n K (T ∩ coreMultiBlockBand A B (n + K) b.val) noncomputable def coreMultiBlockEventMass (A B eta lam : ℝ) (n K r : ℕ) : ℝ := by classical exact ∑ T ∈ (virtualPrimeUniverse A B (r * (n + K))).powerset.filter (CoreMultiBlockEvent A B eta n K r), primeTiltWeight (virtualPrimeUniverse A B (r * (n + K))) lam T theorem coreMultiBlockEventMass_factorization {A B : ℝ} (hB : 0 < B) (eta lam : ℝ) (n K r : ℕ) : coreMultiBlockEventMass A B eta lam n K r = ∏ b : Fin r, coreBlockEventMass A (B * 2 ^ (b.val * (n + K))) eta lam n K := by classical have hdis : Pairwise (fun b c : Fin r ↦ Disjoint (coreMultiBlockBand A B (n + K) b.val) (coreMultiBlockBand A B (n + K) c.val)) := fun _ _ hbc ↦ coreMultiBlockBand_disjoint hB _ (fun h ↦ hbc (Fin.ext h)) have h := prime_tilt_disjoint_band_events_product (fun b : Fin r ↦ coreMultiBlockBand A B (n + K) b.val) hdis lam (fun b ↦ CoreBlockEvent A (B * 2 ^ (b.val * (n + K))) eta n K) rw [coreMultiBlockBand_union hB] at h convert h using 1 · simp only [coreMultiBlockEventMass, CoreMultiBlockEvent, sum_filter] apply sum_congr rfl intro T _ by_cases ht : ∀ b : Fin r, CoreBlockEvent A (B * 2 ^ (b.val * (n + K))) eta n K (T ∩ coreMultiBlockBand A B (n + K) b.val) · simp only [ht] · simp only [ht, if_false] · apply prod_congr rfl intro b _ simp only [coreBlockEventMass, coreMultiBlockBand, sum_filter] theorem coreMultiBlockEvent_card {A B eta : ℝ} {n K r : ℕ} {T : Finset ℕ} (hB : 0 < B) (hT : T ⊆ virtualPrimeUniverse A B (r * (n + K))) (hevent : CoreMultiBlockEvent A B eta n K r T) : T.card = r * (n + K) := by have hdis : Pairwise (fun b c : Fin r ↦ Disjoint (coreMultiBlockBand A B (n + K) b.val) (coreMultiBlockBand A B (n + K) c.val)) := fun _ _ hbc ↦ coreMultiBlockBand_disjoint hB _ (fun h ↦ hbc (Fin.ext h)) have hsub : T ⊆ primeBandUnion (fun b : Fin r ↦ coreMultiBlockBand A B (n + K) b.val) := by rwa [coreMultiBlockBand_union hB] rw [card_primeBand_intersections _ hdis hsub] have hc (b : Fin r) : (T ∩ coreMultiBlockBand A B (n + K) b.val).card = n + K := coreBlockEvent_card (by positivity : 0 < B * (2 : ℝ) ^ (b.val * (n + K))) inter_subset_right (hevent b) simp only [hc, sum_const, card_univ, Fintype.card_fin, smul_eq_mul] theorem coreMultiBlockEvent_log_sum_le {A B eta eps : ℝ} {n K r : ℕ} {T : Finset ℕ} (hB : 0 < B) (hh : 0 < n + K) (hT : T ⊆ virtualPrimeUniverse A B (r * (n + K))) (hevent : CoreMultiBlockEvent A B eta n K r T) (hsize : (n : ℝ) ≤ eps * (2 : ℝ) ^ K) : (∑ p ∈ T, log (p : ℝ)) ≤ (r * (n + K) : ℕ) * A + B * (exp eta + eps) * (2 : ℝ) ^ (r * (n + K)) / (1 - ((2 : ℝ) ^ (n + K))⁻¹) := by have heps : 0 ≤ eps := nonneg_of_mul_nonneg_left ((Nat.cast_nonneg n).trans hsize) (by positivity : (0 : ℝ) < 2 ^ K) have hdis : Pairwise (fun b c : Fin r ↦ Disjoint (coreMultiBlockBand A B (n + K) b.val) (coreMultiBlockBand A B (n + K) c.val)) := fun _ _ hbc ↦ coreMultiBlockBand_disjoint hB _ (fun h ↦ hbc (Fin.ext h)) have hsub : T ⊆ primeBandUnion (fun b : Fin r ↦ coreMultiBlockBand A B (n + K) b.val) := by rwa [coreMultiBlockBand_union hB] have hb (b : Fin r) : (∑ p ∈ T ∩ coreMultiBlockBand A B (n + K) b.val, log (p : ℝ)) ≤ (n + K : ℕ) * A + B * (exp eta + eps) * (2 : ℝ) ^ ((b.val + 1) * (n + K)) := by have h := coreBlockEvent_log_sum_le (by positivity : 0 < B * (2 : ℝ) ^ (b.val * (n + K))) inter_subset_right (hevent b) hsize have hpow : (2 : ℝ) ^ ((b.val + 1) * (n + K)) = (2 : ℝ) ^ (b.val * (n + K)) * (2 : ℝ) ^ (n + K) := by rw [Nat.add_mul, one_mul, pow_add] have heq : (B * (2 : ℝ) ^ (b.val * (n + K))) * (exp eta + eps) * (2 : ℝ) ^ (n + K) = B * (exp eta + eps) * (2 : ℝ) ^ ((b.val + 1) * (n + K)) := by rw [hpow]; ring rw [heq] at h exact h have hgeom : (∑ b : Fin r, (2 : ℝ) ^ ((b.val + 1) * (n + K))) ≤ (2 : ℝ) ^ (r * (n + K)) / (1 - ((2 : ℝ) ^ (n + K))⁻¹) := by rw [Fin.sum_univ_eq_sum_range (fun b : ℕ ↦ (2 : ℝ) ^ ((b + 1) * (n + K)))] exact core_block_geometric_sum_le r hh calc _ = ∑ b : Fin r, ∑ p ∈ T ∩ coreMultiBlockBand A B (n + K) b.val, log (p : ℝ) := sum_primeBand_intersections _ hdis hsub _ _ ≤ ∑ b : Fin r, ((n + K : ℕ) * A + B * (exp eta + eps) * (2 : ℝ) ^ ((b.val + 1) * (n + K))) := sum_le_sum (fun b _ ↦ hb b) _ = (r * (n + K) : ℕ) * A + B * (exp eta + eps) * ∑ b : Fin r, (2 : ℝ) ^ ((b.val + 1) * (n + K)) := by rw [sum_add_distrib] simp only [sum_const, card_univ, Fintype.card_fin, nsmul_eq_mul, Nat.cast_mul] rw [← mul_sum] ring _ ≤ (r * (n + K) : ℕ) * A + B * (exp eta + eps) * ((2 : ℝ) ^ (r * (n + K)) / (1 - ((2 : ℝ) ^ (n + K))⁻¹)) := add_le_add le_rfl (mul_le_mul_of_nonneg_left hgeom (by positivity)) _ = _ := by ring theorem CoreMultiBlockEvent.restrictBlocks {A B eta : ℝ} {n K r s : ℕ} {T : Finset ℕ} (hevent : CoreMultiBlockEvent A B eta n K r T) (hB : 0 < B) (hs : s ≤ r) : CoreMultiBlockEvent A B eta n K s (T ∩ virtualPrimeUniverse A B (s * (n + K))) := by intro b have hbsub := coreMultiBlockBand_subset_universe (A := A) hB b.isLt (n + K) have heq : (T ∩ virtualPrimeUniverse A B (s * (n + K))) ∩ coreMultiBlockBand A B (n + K) b.val = T ∩ coreMultiBlockBand A B (n + K) b.val := by rw [inter_assoc, inter_eq_right.mpr hbsub] rw [heq] exact hevent ⟨b.val, b.isLt.trans_le hs⟩ /-- Every completed block gives an actual selected-prime prefix anchor. -/ theorem coreMultiBlockEvent_endpoint_bounds {A B eta eps : ℝ} {n K r s : ℕ} {T : Finset ℕ} (hB : 0 < B) (hh : 0 < n + K) (hs : s ≤ r) (hevent : CoreMultiBlockEvent A B eta n K r T) (hsize : (n : ℝ) ≤ eps * (2 : ℝ) ^ K) : (T ∩ virtualPrimeUniverse A B (s * (n + K))).card = s * (n + K) ∧ (∑ p ∈ T ∩ virtualPrimeUniverse A B (s * (n + K)), log (p : ℝ)) ≤ (s * (n + K) : ℕ) * A + B * (exp eta + eps) * (2 : ℝ) ^ (s * (n + K)) / (1 - ((2 : ℝ) ^ (n + K))⁻¹) := by have hpref := hevent.restrictBlocks hB hs exact ⟨coreMultiBlockEvent_card hB inter_subset_right hpref, coreMultiBlockEvent_log_sum_le hB hh inter_subset_right hpref hsize⟩ theorem coreMultiBlockEventMass_lower_of_blocks {A B eta lam : ℝ} (hB : 0 < B) (n K r : ℕ) (L : Fin r → ℝ) (hL0 : ∀ b, 0 ≤ L b) (hL : ∀ b, L b ≤ coreBlockEventMass A (B * 2 ^ (b.val * (n + K))) eta lam n K) : (∏ b, L b) ≤ coreMultiBlockEventMass A B eta lam n K r := by rw [coreMultiBlockEventMass_factorization hB] exact prod_le_prod (fun b _ ↦ hL0 b) (fun b _ ↦ hL b) /-- The head parameter is supplied separately for every translated block. This is a finite product bound and asserts no uniform-parameter rate. -/ theorem coreMultiBlockEventMass_explicit_lower {n : ℕ} (hn : 0 < n) (K r : ℕ) {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (heta : 0 < eta) (heta2 : eta ≤ log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ eta * B) (J : Fin r → ℕ) (hAB : ∀ b, A / (B * 2 ^ (b.val * (n + K))) ≤ (2 : ℝ) ^ J b) : (∏ b : Fin r, max 0 (coreBlockPrefixLower A (B * 2 ^ (b.val * (n + K))) lam n (J b)) * coreBlockSuffixLower A (B * 2 ^ (b.val * (n + K))) eta lam n K) ≤ coreMultiBlockEventMass A B eta lam n K r := by apply coreMultiBlockEventMass_lower_of_blocks hB n K r · intro b exact mul_nonneg (le_max_left _ _) (coreBlockSuffixLower_nonneg hA (by positivity : 0 < B * (2 : ℝ) ^ (b.val * (n + K))) heta.le (by linarith) n K) · intro b have hp : (1 : ℝ) ≤ 2 ^ (b.val * (n + K)) := one_le_pow₀ (by norm_num) have hBB : B ≤ B * (2 : ℝ) ^ (b.val * (n + K)) := by simpa only [mul_one] using mul_le_mul_of_nonneg_left hp hB.le have hlargeB : 4 * primeLogOddsErrorConstant ≤ eta * (B * (2 : ℝ) ^ (b.val * (n + K))) := hlarge.trans (mul_le_mul_of_nonneg_left hBB heta.le) exact coreBlockEventMass_explicit_lower hn K hA (by positivity) (hbase.trans (add_le_add le_rfl hBB)) heta heta2 hlam hlam2 hlargeB (hAB b) end Erdos859Verification end /- Inlined development module: PrimePairHoleIteration.lean -/ section /- Adaptive quadratic hole filling under finite independent prime-subset laws. -/ namespace Erdos859Verification open Finset Real MeasureTheory theorem sum_piFinset_snoc {α : Type*} [DecidableEq α] (S : ℕ → Finset α) (n : ℕ) (F : (Fin (n + 1) → α) → ℝ) : (∑ x ∈ Fintype.piFinset (fun i : Fin (n + 1) ↦ S i.val), F x) = ∑ x ∈ Fintype.piFinset (fun i : Fin n ↦ S i.val), ∑ y ∈ S n, F (Fin.snoc x y) := by classical have he := Finset.filter_piFinset_eq_map_snocEquiv (fun i : Fin (n + 1) ↦ S i.val) (fun _ ↦ True) simp only [filter_true] at he rw [he, sum_map, sum_product, sum_comm] rfl theorem finite_adaptive_prefix_lower {α : Type*} [DecidableEq α] (S : ℕ → Finset α) (w : ℕ → α → ℝ) (c : ℕ → ℝ) (Good : (n : ℕ) → (Fin n → α) → Prop) [∀ n, DecidablePred (Good n)] (hw : ∀ i x, x ∈ S i → 0 ≤ w i x) (hzero : ∀ x, Good 0 x) (n : ℕ) (hc : ∀ i < n, 0 ≤ c i) (hstep : ∀ i < n, ∀ x ∈ Fintype.piFinset (fun j : Fin i ↦ S j.val), Good i x → c i ≤ ∑ y ∈ S i, w i y * (if Good (i + 1) (Fin.snoc x y) then 1 else 0)) : (∏ i ∈ range n, c i) ≤ ∑ x ∈ Fintype.piFinset (fun i : Fin n ↦ S i.val), (∏ i, w i.val (x i)) * (if Good n x then 1 else 0) := by classical induction n with | zero => simp [hzero] | succ n ih => have hi := ih (fun i hi ↦ hc i (by omega)) (fun i hi ↦ hstep i (by omega)) rw [prod_range_succ] apply (mul_le_mul_of_nonneg_right hi (hc n (by omega))).trans rw [sum_mul, sum_piFinset_snoc] apply sum_le_sum intro x hx have hweight : 0 ≤ ∏ i : Fin n, w i.val (x i) := prod_nonneg (fun i _ ↦ hw i.val (x i) (Fintype.mem_piFinset.mp hx i)) have hfactor : (∑ y ∈ S n, (∏ i : Fin (n + 1), w i.val ((Fin.snoc x y : Fin (n + 1) → α) i)) * (if Good (n + 1) (Fin.snoc x y) then 1 else 0)) = (∏ i : Fin n, w i.val (x i)) * (∑ y ∈ S n, w n y * (if Good (n + 1) (Fin.snoc x y) then 1 else 0)) := by rw [mul_sum] apply sum_congr rfl intro y _ rw [Fin.prod_univ_castSucc] simp only [Fin.snoc_castSucc, Fin.snoc_last, Fin.val_castSucc, Fin.val_last, mul_assoc] rw [hfactor] by_cases hg : Good n x · rw [if_pos hg, mul_one] exact mul_le_mul_of_nonneg_left (hstep n (by omega) x hx hg) hweight · rw [if_neg hg, mul_zero, zero_mul] exact mul_nonneg hweight (sum_nonneg (fun y hy ↦ mul_nonneg (hw n y hy) (by split_ifs <;> norm_num))) theorem isCompact_realTranslateSet {A : Set ℝ} (hA : IsCompact A) (g : ℝ) : IsCompact (realTranslateSet A g) := by have heq : realTranslateSet A g = (fun x : ℝ ↦ x + g) '' A := by ext z constructor · intro hz exact ⟨z - g, hz, sub_add_cancel z g⟩ · rintro ⟨x, hx, rfl⟩ simpa only [realTranslateSet, Set.mem_preimage, add_sub_cancel_right] using hx rw [heq] exact hA.image (by fun_prop) def quadraticHoleInterval (ell a b : ℝ) (n : ℕ) : Set ℝ := Set.Icc (a + quadraticHoleTrim ell n) (b - quadraticHoleTrim ell n) theorem quadraticHoleInterval_succ (ell a b : ℝ) (n : ℕ) : quadraticHoleInterval ell a b (n + 1) = Set.Icc ((a + quadraticHoleTrim ell n) + quadraticHoleWidth ell n) ((b - quadraticHoleTrim ell n) - quadraticHoleWidth ell n) := by simp only [quadraticHoleInterval, quadraticHoleTrim_succ, add_assoc, sub_add_eq_sub_sub] inductive PrimePairHolePath (ell e a b : ℝ) (A : Set ℝ) : (n : ℕ) → (Fin n → Finset ℕ) → Set ℝ → Prop where | initial (x : Fin 0 → Finset ℕ) : PrimePairHolePath ell e a b A 0 x A | step {n : ℕ} {x : Fin n → Finset ℕ} {S : Set ℝ} (hpath : PrimePairHolePath ell e a b A n x S) {T : Finset ℕ} (hcard : T.card = 2) {p q : ℕ} (hp : p ∈ T) (hq : q ∈ T) (hholes : volume.real (quadraticHoleInterval ell a b (n + 1) \ realSupportThickening (S ∪ realTranslateSet S (log (p : ℝ) - log (q : ℝ))) e) ≤ 4 * (volume.real (quadraticHoleInterval ell a b n \ S)) ^ 2 / quadraticHoleWidth ell n) : PrimePairHolePath ell e a b A (n + 1) (Fin.snoc x T) (realSupportThickening (S ∪ realTranslateSet S (log (p : ℝ) - log (q : ℝ))) e) theorem PrimePairHolePath.isCompact {ell e a b : ℝ} {A S : Set ℝ} {n : ℕ} {x : Fin n → Finset ℕ} (h : PrimePairHolePath ell e a b A n x S) (hA : IsCompact A) : IsCompact S := by induction h with | initial => exact hA | step _ _ _ _ _ ih => exact isCompact_realSupportThickening (ih.union (isCompact_realTranslateSet ih _)) _ theorem PrimePairHolePath.counts {ell e a b : ℝ} {A S : Set ℝ} {n : ℕ} {x : Fin n → Finset ℕ} (h : PrimePairHolePath ell e a b A n x S) : ∀ i, (x i).card = 2 := by induction h with | initial => exact fun i ↦ Fin.elim0 i | step _ hcard _ _ _ ih => apply Fin.lastCases · simpa only [Fin.snoc_last] using hcard · intro i simpa only [Fin.snoc_castSucc] using ih i theorem PrimePairHolePath.hole_bound {ell e a b : ℝ} {A S : Set ℝ} {n : ℕ} {x : Fin n → Finset ℕ} (h : PrimePairHolePath ell e a b A n x S) (hell : 0 < ell) (hstart : volume.real (Set.Icc a b \ A) ≤ ell / (2 : ℝ) ^ 10) : volume.real (quadraticHoleInterval ell a b n \ S) ≤ ell / (2 : ℝ) ^ quadraticHoleExponent n := by induction h with | initial => simpa only [quadraticHoleInterval, quadraticHoleTrim_zero, add_zero, sub_zero, quadraticHoleExponent, pow_zero, Nat.mul_one, Nat.add_zero] using hstart | @step n x S hp T hc p q hpm hqm hh ih => have hold : volume.real (quadraticHoleInterval ell a b n \ S) / ell ≤ 1 / (2 : ℝ) ^ quadraticHoleExponent n := by apply (div_le_iff₀ hell).mpr simpa only [div_eq_mul_inv, one_mul, mul_comm] using ih have hnew := quadraticHole_step_normalize hell n hh have hbound := hnew.trans (mul_le_mul_of_nonneg_left (pow_le_pow_left₀ (div_nonneg measureReal_nonneg hell.le) hold 2) (by positivity)) rw [quadraticHole_step_identity n] at hbound have hphys := (div_le_iff₀ hell).mp hbound simpa only [div_eq_mul_inv, one_mul, mul_comm] using hphys theorem thickening_subset_finiteThickenedTranslateSupport {A S : Set ℝ} {ι : Type*} {P : Finset ι} {x : ι → ℝ} {d e : ℝ} (hS : S ⊆ finiteThickenedTranslateSupport A P x d) : realSupportThickening S e ⊆ finiteThickenedTranslateSupport A P x (d + e) := by intro z hz obtain ⟨t, ht, hzt⟩ := hz obtain ⟨J, hJ, a, ha, hta⟩ := mem_finiteThickenedTranslateSupport.mp (hS ht) refine mem_finiteThickenedTranslateSupport.mpr ⟨J, hJ, a, ha, ?_⟩ have hid : z - a - (∑ i ∈ J, x i) = (z - t) + (t - a - (∑ i ∈ J, x i)) := by ring rw [hid] exact (abs_add_le _ _).trans (by linarith) theorem finiteThickenedTranslateSupport_snoc {n : ℕ} (A : Set ℝ) (x : Fin n → ℝ) (g d : ℝ) : finiteThickenedTranslateSupport A univ (Fin.snoc x g) d = finiteThickenedTranslateSupport A univ x d ∪ realTranslateSet (finiteThickenedTranslateSupport A univ x d) g := by simpa only [finiteThickenedTranslateSupport, finiteBitTranslateSupport_eq_subsetSupport] using finiteBitTranslateSupport_snoc (realSupportThickening A d) x g theorem thickened_refinement_step_subset {A S : Set ℝ} {n : ℕ} {x : Fin n → ℝ} {d e g : ℝ} (hS : S ⊆ finiteThickenedTranslateSupport A univ x d) : realSupportThickening (S ∪ realTranslateSet S g) e ⊆ finiteThickenedTranslateSupport A univ (Fin.snoc x g) (d + e) := by rw [realSupportThickening_union_translate, finiteThickenedTranslateSupport_snoc] have ht := thickening_subset_finiteThickenedTranslateSupport (e := e) hS exact Set.union_subset_union ht (fun _ hz ↦ ht hz) theorem PrimePairHolePath.geometry {ell e a b : ℝ} {A S : Set ℝ} {n : ℕ} {x : Fin n → Finset ℕ} (h : PrimePairHolePath ell e a b A n x S) : ∃ g : Fin n → ℝ, (∀ i, ∃ p ∈ x i, ∃ q ∈ x i, g i = log (p : ℝ) - log (q : ℝ)) ∧ S ⊆ finiteThickenedTranslateSupport A univ g ((n : ℝ) * e) := by induction h with | initial x => let g : Fin 0 → ℝ := fun i ↦ Fin.elim0 i refine ⟨g, fun i ↦ Fin.elim0 i, ?_⟩ have hz := finiteBitTranslateSupport_zero A g rw [finiteBitTranslateSupport_eq_subsetSupport] at hz simpa only [Nat.cast_zero, zero_mul, finiteThickenedTranslateSupport, realSupportThickening_zero, hz] using Set.Subset.refl A | @step n x S hpath T hc p q hp hq hh ih => obtain ⟨g, hg, hS⟩ := ih refine ⟨Fin.snoc g (log (p : ℝ) - log (q : ℝ)), ?_, ?_⟩ · apply Fin.lastCases · simpa only [Fin.snoc_last] using ⟨p, hp, q, hq, rfl⟩ · intro i simpa only [Fin.snoc_castSucc] using hg i · have ht := thickened_refinement_step_subset (e := e) (g := log (p : ℝ) - log (q : ℝ)) hS convert ht using 1 congr 1 push_cast ring def PrimePairHoleSuccess (ell e a b : ℝ) (A : Set ℝ) (n : ℕ) (x : Fin n → Finset ℕ) : Prop := ∃ S, PrimePairHolePath ell e a b A n x S theorem PrimePairHoleSuccess.mesh {ell e a b : ℝ} {A : Set ℝ} {n : ℕ} {x : Fin n → Finset ℕ} (h : PrimePairHoleSuccess ell e a b A n x) (hell : 0 < ell) (hstart : volume.real (Set.Icc a b \ A) ≤ ell / (2 : ℝ) ^ 10) : (∀ i, (x i).card = 2) ∧ ∃ g : Fin n → ℝ, (∀ i, ∃ p ∈ x i, ∃ q ∈ x i, g i = log (p : ℝ) - log (q : ℝ)) ∧ volume.real (quadraticHoleInterval ell a b n \ finiteThickenedTranslateSupport A univ g ((n : ℝ) * e)) ≤ ell / (2 : ℝ) ^ quadraticHoleExponent n := by obtain ⟨S, hpath⟩ := h obtain ⟨g, hg, hS⟩ := hpath.geometry refine ⟨hpath.counts, g, hg, ?_⟩ apply le_trans _ (hpath.hole_bound hell hstart) exact measureReal_mono (Set.sdiff_subset_sdiff_right hS) (measure_ne_top_of_subset Set.sdiff_subset isCompact_Icc.measure_ne_top) noncomputable def primePairStepCost (eps eta : ℝ) : ℝ := eta * exp (-5 * eps) * (eps / 4) ^ 2 / 2 def PrimePairHoleWindowConditions (ell : ℝ) (u eps eta : ℕ → ℝ) (n : ℕ) : Prop := ∀ i < n, log 2 ≤ u i ∧ 0 < eps i ∧ eps i ≤ 1 ∧ 8 * primeLogOddsErrorConstant ≤ eps i * u i ∧ 0 ≤ eta i ∧ eta i ≤ (1 : ℝ) / 2 - 64 * exp (-u i) / eps i ∧ eps i * u i = quadraticHoleWidth ell i theorem primeTilt_independent_adaptive_hole_filling {A : Set ℝ} (hA : IsCompact A) {ell a b lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (u eps eta : ℕ → ℝ) (n : ℕ) (hwin : PrimePairHoleWindowConditions ell u eps eta n) : (∏ i ∈ range n, primePairStepCost (eps i) (eta i)) ≤ ∑ x ∈ primeBandSelections (fun i : Fin n ↦ primeLogWindow (u i.val) ((1 + eps i.val) * u i.val)), (∏ i, primeTiltWeight (primeLogWindow (u i.val) ((1 + eps i.val) * u i.val)) lam (x i)) * (if PrimePairHoleSuccess ell (32 * primeLogOddsErrorConstant) a b A n x then 1 else 0) := by classical let P : ℕ → Finset ℕ := fun i ↦ primeLogWindow (u i) ((1 + eps i) * u i) change (∏ i ∈ range n, primePairStepCost (eps i) (eta i)) ≤ ∑ x ∈ Fintype.piFinset (fun i : Fin n ↦ (P i.val).powerset), (∏ i, primeTiltWeight (P i.val) lam (x i)) * (if PrimePairHoleSuccess ell (32 * primeLogOddsErrorConstant) a b A n x then 1 else 0) apply finite_adaptive_prefix_lower (fun i ↦ (P i).powerset) (fun i T ↦ primeTiltWeight (P i) lam T) (fun i ↦ primePairStepCost (eps i) (eta i)) (PrimePairHoleSuccess ell (32 * primeLogOddsErrorConstant) a b A) · intro i T _ exact (primeTiltWeight_pos (fun p hp ↦ (mem_primeLogWindow.mp hp).1) (by linarith : 0 < lam) T).le · intro x exact ⟨A, PrimePairHolePath.initial x⟩ · intro i hi have heta := (hwin i hi).2.2.2.2.1 unfold primePairStepCost positivity · intro i hi x _ hx obtain ⟨S, hpath⟩ := hx obtain ⟨hui, hepsi, hepsi1, hlarge, hetai, hmargin, hwidth⟩ := hwin i hi let ai := a + quadraticHoleTrim ell i let bi := b - quadraticHoleTrim ell i let StepGood : Finset ℕ → Prop := fun T ↦ T.card = 2 ∧ PrimePairHoleFillingEvent S (Set.Icc (ai + eps i * u i) (bi - eps i * u i)) (32 * primeLogOddsErrorConstant) (4 * (volume.real (Set.Icc ai bi \ S)) ^ 2 / (eps i * u i)) T have hlocal : primePairStepCost (eps i) (eta i) ≤ ∑ T ∈ (P i).powerset.filter StepGood, primeTiltWeight (P i) lam T := primeTilt_two_prime_hole_filling (hpath.isCompact hA) hlam hlam2 hui hepsi hepsi1 hlarge hetai hmargin have hext (T : Finset ℕ) (hT : StepGood T) : PrimePairHoleSuccess ell (32 * primeLogOddsErrorConstant) a b A (i + 1) (Fin.snoc x T) := by obtain ⟨hcard, p, hp, q, hq, hholes⟩ := hT refine ⟨_, PrimePairHolePath.step hpath hcard hp hq ?_⟩ rw [quadraticHoleInterval_succ] simpa only [ai, bi, hwidth, quadraticHoleInterval] using hholes apply hlocal.trans rw [sum_filter] apply sum_le_sum intro T _ have hwT : 0 ≤ primeTiltWeight (P i) lam T := (primeTiltWeight_pos (fun p hp ↦ (mem_primeLogWindow.mp hp).1) (by linarith : 0 < lam) T).le change (if StepGood T then primeTiltWeight (P i) lam T else 0) ≤ primeTiltWeight (P i) lam T * (if PrimePairHoleSuccess ell (32 * primeLogOddsErrorConstant) a b A (i + 1) (Fin.snoc x T) then 1 else 0) by_cases hT : StepGood T · simp only [if_pos hT, if_pos (hext T hT), mul_one, le_refl] · simp only [if_neg hT] exact mul_nonneg hwT (by split_ifs <;> norm_num) theorem primeTilt_ambient_adaptive_hole_filling {A : Set ℝ} (hA : IsCompact A) {ell a b lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (u eps eta : ℕ → ℝ) (n : ℕ) (hwin : PrimePairHoleWindowConditions ell u eps eta n) (hdis : Pairwise (fun i j : Fin n ↦ Disjoint (primeLogWindow (u i.val) ((1 + eps i.val) * u i.val)) (primeLogWindow (u j.val) ((1 + eps j.val) * u j.val)))) : (∏ i ∈ range n, primePairStepCost (eps i) (eta i)) ≤ ∑ T ∈ (primeBandUnion (fun i : Fin n ↦ primeLogWindow (u i.val) ((1 + eps i.val) * u i.val))).powerset, primeTiltWeight (primeBandUnion (fun i : Fin n ↦ primeLogWindow (u i.val) ((1 + eps i.val) * u i.val))) lam T * (if PrimePairHoleSuccess ell (32 * primeLogOddsErrorConstant) a b A n (fun i ↦ T ∩ primeLogWindow (u i.val) ((1 + eps i.val) * u i.val)) then 1 else 0) := by classical rw [prime_tilt_expectation_primeBand_partition _ hdis lam (fun x ↦ if PrimePairHoleSuccess ell (32 * primeLogOddsErrorConstant) a b A n x then 1 else 0)] exact primeTilt_independent_adaptive_hole_filling hA hlam hlam2 u eps eta n hwin theorem primeBandSelections_weights_normalized {ι : Type*} [Fintype ι] [DecidableEq ι] (P : ι → Finset ℕ) (hP : ∀ i p, p ∈ P i → p.Prime) {lam : ℝ} (hlam : 0 < lam) : (∑ x ∈ primeBandSelections P, ∏ i, primeTiltWeight (P i) lam (x i)) = 1 := by classical rw [primeBandSelections, ← prod_univ_sum] simp only [sum_primeTiltWeight (hP _) hlam, prod_const_one] end Erdos859Verification end /- Inlined development module: PrimePairInitialCoverage.lean -/ section /- Initial coverage with a quantitative probability under actual prime-pair laws. -/ namespace Erdos859Verification open Finset Real MeasureTheory open scoped ENNReal theorem nonnegative_contraction_success_probability {mu : Measure ℝ} [IsProbabilityMeasure mu] {H : ℝ → ℝ} (hH : Measurable H) (hH0 : ∀ x, 0 ≤ H x) (hHi : Integrable H mu) {d b : ℝ} (_hd : 0 ≤ d) (hd1 : d ≤ 1) (hb : 0 ≤ b) (hmean : (∫ x, H x ∂mu) ≤ (1 - d) * b) : d / 2 ≤ mu.real {x | H x ≤ (1 - d / 2) * b} := by let R := (1 - d / 2) * b have hgood : MeasurableSet {x | H x ≤ R} := measurableSet_le hH measurable_const by_cases hb0 : b = 0 · have hi0 : (∫ x, H x ∂mu) = 0 := by apply le_antisymm _ (integral_nonneg hH0) simpa only [hb0, mul_zero] using hmean have hae := (integral_eq_zero_iff_of_nonneg hH0 hHi).mp hi0 have he : {x | H x ≤ R} ∈ ae mu := by filter_upwards [hae] with x hx simp only [hx, Pi.zero_apply, R, hb0, mul_zero, le_refl] have hp := (mem_ae_iff_prob_eq_one hgood).mp he change d / 2 ≤ mu.real {x | H x ≤ R} rw [Measure.real, hp, ENNReal.toReal_one] linarith · have hbpos : 0 < b := lt_of_le_of_ne hb (Ne.symm hb0) have hRpos : 0 < R := mul_pos (by linarith) hbpos have hm := mul_meas_ge_le_integral_of_nonneg (Filter.Eventually.of_forall hH0) hHi R have hscalar : (1 - d) * b ≤ R * (1 - d / 2) := by dsimp [R] nlinarith [mul_nonneg (sq_nonneg d) hb] have htail : mu.real {x | R ≤ H x} ≤ 1 - d / 2 := by have ht := (hm.trans hmean).trans hscalar nlinarith have hcomp : mu.real {x | H x ≤ R}ᶜ ≤ mu.real {x | R ≤ H x} := by apply measureReal_mono _ (measure_ne_top _ _) intro x hx change ¬ H x ≤ R at hx exact (lt_of_not_ge hx).le have hsum := probReal_add_probReal_compl (μ := mu) hgood change d / 2 ≤ mu.real {x | H x ≤ R} linarith theorem logUniformPairDensity_two_length_lower {u L t : ℝ} (hL : 0 < L) (hu : 2 * L ≤ u) (ht : t ∈ Set.Icc (-L) L) : (1 / 16 : ℝ) / L ≤ logUniformPairDensity u (2 * L) t := by have hf := (logUniformPairDensity_properties (by positivity : (0 : ℝ) < 2 * L) hu).2.2.2.2.2 t have ht' : |t| ≤ L := abs_le.mpr ht apply le_trans _ hf rw [max_eq_left (by linarith : 0 ≤ 2 * L - |t|)] have hden : 0 < 4 * (2 * L) ^ 2 := by positivity apply (div_le_div_iff₀ hL hden).mpr nlinarith [mul_le_mul_of_nonneg_left ht' hL.le] theorem initialCoverage_success_probability {E B : Set ℝ} (hE : MeasurableSet E) (hB : MeasurableSet B) {L c rho : ℝ} (hEI : E ⊆ Set.Icc 0 L) (hBI : B ⊆ Set.Icc 0 L) (hL : 0 < L) (hc : 0 ≤ c) (hrho : 0 ≤ rho) (hprod : c * rho ≤ 1) (hBvol : rho * L ≤ volume.real B) {f : ℝ → ℝ} (hf : Measurable f) (hf0 : ∀ g, 0 ≤ f g) (hflower : ∀ g ∈ Set.Icc (-L) L, c / L ≤ f g) (hmass : (∫⁻ g : ℝ, ENNReal.ofReal (f g)) = 1) : c * rho / 2 ≤ (translationShiftLaw f).real {g | volume.real (E \ realTranslateSet B g) ≤ (1 - c * rho / 2) * volume.real E} := by let : IsProbabilityMeasure (translationShiftLaw f) := translationShiftLaw_isProbability f hmass have hEfin : volume E ≠ ∞ := measure_ne_top_of_subset hEI isCompact_Icc.measure_ne_top have hm : Measurable (fun g ↦ volume.real (E \ realTranslateSet B g)) := by have heq : (fun g ↦ volume.real (E \ realTranslateSet B g)) = fun g ↦ volume.real E - crossTranslationOverlap E B g := funext (missing_after_translate_eq hE hB hEfin) rw [heq] exact measurable_const.sub (measurable_crossTranslationOverlap hE hB) have hmain := initialCoverage_expectation_contraction hE hB hEI hBI hf hf0 hflower hmass have hlow : c * rho ≤ c * volume.real B / L := by apply (le_div_iff₀ hL).mpr nlinarith [mul_le_mul_of_nonneg_left hBvol hc] apply nonnegative_contraction_success_probability hm (fun _ ↦ measureReal_nonneg) hmain.1 (mul_nonneg hc hrho) hprod measureReal_nonneg exact hmain.2.trans (mul_le_mul_of_nonneg_right (sub_le_sub_left hlow 1) measureReal_nonneg) theorem base_coverage_fraction_le_one {B : Set ℝ} {rho L : ℝ} (hL : 0 < L) (hBI : B ⊆ Set.Icc 0 L) (hBvol : rho * L ≤ volume.real B) : rho ≤ 1 := by have hb := measureReal_mono (μ := volume) hBI isCompact_Icc.measure_ne_top rw [volume_real_Icc_of_le hL.le, sub_zero] at hb nlinarith noncomputable def baseTranslateHole (A B I : Set ℝ) (g : ℝ) : ℝ := volume.real (I \ (A ∪ realTranslateSet B g)) theorem baseTranslateHole_eq (A B I : Set ℝ) (g : ℝ) : baseTranslateHole A B I g = volume.real ((I \ A) \ realTranslateSet B g) := by unfold baseTranslateHole apply congrArg volume.real ext x simp only [Set.mem_sdiff, Set.mem_union, not_or] tauto theorem measurable_baseTranslateHole {A B I : Set ℝ} (hA : MeasurableSet A) (hB : MeasurableSet B) (hI : MeasurableSet I) (hIfin : volume I ≠ ∞) : Measurable (baseTranslateHole A B I) := by have heq : baseTranslateHole A B I = fun g ↦ volume.real (I \ A) - crossTranslationOverlap (I \ A) B g := by funext g rw [baseTranslateHole_eq, missing_after_translate_eq (hI.diff hA) hB (measure_ne_top_of_subset Set.sdiff_subset hIfin)] rw [heq] exact measurable_const.sub (measurable_crossTranslationOverlap (hI.diff hA) hB) theorem logUniformPair_initial_success_probability {A B : Set ℝ} (hA : MeasurableSet A) (hB : MeasurableSet B) {L rho u : ℝ} (hL : 0 < L) (hrho : 0 ≤ rho) (hBI : B ⊆ Set.Icc 0 L) (hBvol : rho * L ≤ volume.real B) (hu : 2 * L ≤ u) : rho / 32 ≤ (translationShiftLaw (logUniformPairDensity u (2 * L))).real {g | baseTranslateHole A B (Set.Icc 0 L) g ≤ (1 - rho / 32) * volume.real (Set.Icc 0 L \ A)} := by have hrho1 := base_coverage_fraction_le_one hL hBI hBvol have hf := logUniformPairDensity_properties (by positivity : (0 : ℝ) < 2 * L) hu have h := initialCoverage_success_probability (measurableSet_Icc.diff hA) hB Set.sdiff_subset hBI hL (c := 1 / 16) (by norm_num) hrho (by linarith) hBvol hf.1 hf.2.1 (fun g hg ↦ logUniformPairDensity_two_length_lower hL hu hg) hf.2.2.1 simpa only [baseTranslateHole_eq, show (1 / 16 : ℝ) * rho / 2 = rho / 32 by ring] using h theorem baseTranslateHole_thickened_shift_le {A B I : Set ℝ} {x y e : ℝ} (hxy : |y - x| ≤ e) (hIfin : volume I ≠ ∞) : baseTranslateHole A (realSupportThickening B e) I y ≤ baseTranslateHole A B I x := by apply measureReal_mono _ (measure_ne_top_of_subset Set.sdiff_subset hIfin) apply Set.sdiff_subset_sdiff_right apply Set.union_subset_union_right intro z hz refine ⟨z - x, hz, ?_⟩ have hid : z - y - (z - x) = x - y := by ring rw [hid, abs_sub_comm] exact hxy def PrimePairInitialEvent (A B : Set ℝ) (L rho e : ℝ) (T : Finset ℕ) : Prop := ∃ p ∈ T, ∃ q ∈ T, baseTranslateHole A (realSupportThickening B e) (Set.Icc 0 L) (log (p : ℝ) - log (q : ℝ)) ≤ (1 - rho / 32) * volume.real (Set.Icc 0 L \ A) theorem primeTilt_initial_coverage_step {A B : Set ℝ} (hA : IsCompact A) (hB : IsCompact B) {L rho lam u eps eta : ℝ} (hL : 0 < L) (hrho : 0 ≤ rho) (hBI : B ⊆ Set.Icc 0 L) (hBvol : rho * L ≤ volume.real B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hu : log 2 ≤ u) (heps : 0 < eps) (heps1 : eps ≤ 1) (hlarge : 8 * primeLogOddsErrorConstant ≤ eps * u) (hwidth : eps * u = 2 * L) (heta : 0 ≤ eta) (hmargin : eta ≤ rho / 32 - 64 * exp (-u) / eps) : primePairStepCost eps eta ≤ ∑ T ∈ (primeLogWindow u ((1 + eps) * u)).powerset.filter (fun T ↦ T.card = 2 ∧ PrimePairInitialEvent A B L rho (32 * primeLogOddsErrorConstant) T), primeTiltWeight (primeLogWindow u ((1 + eps) * u)) lam T := by classical let R := (1 - rho / 32) * volume.real (Set.Icc 0 L \ A) let E : Set ℝ := {x | baseTranslateHole A B (Set.Icc 0 L) x ≤ R} let G : Set ℝ := {y | baseTranslateHole A (realSupportThickening B (32 * primeLogOddsErrorConstant)) (Set.Icc 0 L) y ≤ R} have hE : MeasurableSet E := measurableSet_le (measurable_baseTranslateHole hA.measurableSet hB.measurableSet measurableSet_Icc isCompact_Icc.measure_ne_top) measurable_const have hG : MeasurableSet G := measurableSet_le (measurable_baseTranslateHole hA.measurableSet (measurableSet_realSupportThickening hB _) measurableSet_Icc isCompact_Icc.measure_ne_top) measurable_const have hrobust : ∀ x ∈ E, ∀ y, |y - x| ≤ 32 * primeLogOddsErrorConstant → y ∈ G := by intro x hx y hxy exact (baseTranslateHole_thickened_shift_le hxy isCompact_Icc.measure_ne_top).trans hx have hu0 : 0 < u := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hu have hwu : 2 * L ≤ u := hwidth.symm ▸ mul_le_of_le_one_left hu0.le heps1 have hprob : rho / 32 ≤ (translationShiftLaw (logUniformPairDensity u (eps * u)) E).toReal := by rw [hwidth] exact logUniformPair_initial_success_probability hA.measurableSet hB.measurableSet hL hrho hBI hBvol hwu have h := primeTilt_broad_robust_pair_lower hlam hlam2 hu heps heps1 hlarge hE hG hrobust hprob heta hmargin exact h inductive PrimePairInitialPath (L rho e : ℝ) (B : Set ℝ) : (n : ℕ) → (Fin n → Finset ℕ) → Set ℝ → Prop where | initial (x : Fin 0 → Finset ℕ) : PrimePairInitialPath L rho e B 0 x B | step {n : ℕ} {x : Fin n → Finset ℕ} {A : Set ℝ} (hpath : PrimePairInitialPath L rho e B n x A) {T : Finset ℕ} (hcard : T.card = 2) {p q : ℕ} (hp : p ∈ T) (hq : q ∈ T) (hholes : baseTranslateHole A (realSupportThickening B e) (Set.Icc 0 L) (log (p : ℝ) - log (q : ℝ)) ≤ (1 - rho / 32) * volume.real (Set.Icc 0 L \ A)) : PrimePairInitialPath L rho e B (n + 1) (Fin.snoc x T) (A ∪ realTranslateSet (realSupportThickening B e) (log (p : ℝ) - log (q : ℝ))) theorem PrimePairInitialPath.isCompact {L rho e : ℝ} {A B : Set ℝ} {n : ℕ} {x : Fin n → Finset ℕ} (h : PrimePairInitialPath L rho e B n x A) (hB : IsCompact B) : IsCompact A := by induction h with | initial => exact hB | step _ _ _ _ _ ih => exact ih.union (isCompact_realTranslateSet (isCompact_realSupportThickening hB _) _) theorem PrimePairInitialPath.base_subset {L rho e : ℝ} {A B : Set ℝ} {n : ℕ} {x : Fin n → Finset ℕ} (h : PrimePairInitialPath L rho e B n x A) : B ⊆ A := by induction h with | initial => exact Set.Subset.rfl | step _ _ _ _ _ ih => exact ih.trans Set.subset_union_left theorem PrimePairInitialPath.counts {L rho e : ℝ} {A B : Set ℝ} {n : ℕ} {x : Fin n → Finset ℕ} (h : PrimePairInitialPath L rho e B n x A) : ∀ i, (x i).card = 2 := by induction h with | initial => exact fun i ↦ Fin.elim0 i | step _ hc _ _ _ ih => apply Fin.lastCases · simpa only [Fin.snoc_last] using hc · intro i simpa only [Fin.snoc_castSucc] using ih i theorem PrimePairInitialPath.hole_bound {L rho e : ℝ} {A B : Set ℝ} {n : ℕ} {x : Fin n → Finset ℕ} (h : PrimePairInitialPath L rho e B n x A) (hL : 0 ≤ L) (hrho : rho ≤ 32) : volume.real (Set.Icc 0 L \ A) ≤ (1 - rho / 32) ^ n * L := by induction h with | initial => have hh := measureReal_mono (μ := volume) (Set.sdiff_subset (s := Set.Icc 0 L) (t := B)) isCompact_Icc.measure_ne_top simpa only [volume_real_Icc_of_le hL, sub_zero, pow_zero, one_mul] using hh | @step n x A hp T hc p q hpm hqm hh ih => have hb := hh.trans (mul_le_mul_of_nonneg_left ih (by linarith : 0 ≤ 1 - rho / 32)) simpa only [baseTranslateHole, pow_succ, mul_left_comm, mul_assoc] using hb theorem PrimePairInitialPath.geometry {L rho e : ℝ} {A B : Set ℝ} {n : ℕ} {x : Fin n → Finset ℕ} (h : PrimePairInitialPath L rho e B n x A) (he : 0 ≤ e) : ∃ g : Fin n → ℝ, (∀ i, ∃ p ∈ x i, ∃ q ∈ x i, g i = log (p : ℝ) - log (q : ℝ)) ∧ A ⊆ finiteThickenedTranslateSupport B univ g e := by induction h with | initial x => let g : Fin 0 → ℝ := fun i ↦ Fin.elim0 i refine ⟨g, fun i ↦ Fin.elim0 i, ?_⟩ have hz := finiteBitTranslateSupport_zero (realSupportThickening B e) g rw [finiteBitTranslateSupport_eq_subsetSupport] at hz change B ⊆ finiteSubsetTranslateSupport (realSupportThickening B e) univ g rw [hz] intro z hzB exact ⟨z, hzB, by simpa only [sub_self, abs_zero] using he⟩ | @step n x A hpath T hc p q hp hq hh ih => obtain ⟨g, hg, hA⟩ := ih refine ⟨Fin.snoc g (log (p : ℝ) - log (q : ℝ)), ?_, ?_⟩ · apply Fin.lastCases · simpa only [Fin.snoc_last] using ⟨p, hp, q, hq, rfl⟩ · intro i simpa only [Fin.snoc_castSucc] using hg i · rw [finiteThickenedTranslateSupport_snoc] apply Set.union_subset_union hA intro z hz apply mem_finiteSubsetTranslateSupport.mpr refine ⟨∅, empty_subset _, ?_⟩ change z - (log (p : ℝ) - log (q : ℝ)) ∈ realSupportThickening B e at hz simpa only [sum_empty, sub_zero] using hz def PrimePairInitialSuccess (L rho e : ℝ) (B : Set ℝ) (n : ℕ) (x : Fin n → Finset ℕ) : Prop := ∃ A, PrimePairInitialPath L rho e B n x A def PrimePairInitialWindowConditions (L rho : ℝ) (u eps eta : ℕ → ℝ) (n : ℕ) : Prop := ∀ i < n, log 2 ≤ u i ∧ 0 < eps i ∧ eps i ≤ 1 ∧ 8 * primeLogOddsErrorConstant ≤ eps i * u i ∧ 0 ≤ eta i ∧ eta i ≤ rho / 32 - 64 * exp (-u i) / eps i ∧ eps i * u i = 2 * L theorem primeTilt_independent_initial_coverage {B : Set ℝ} (hB : IsCompact B) {L rho lam : ℝ} (hL : 0 < L) (hrho : 0 ≤ rho) (hBI : B ⊆ Set.Icc 0 L) (hBvol : rho * L ≤ volume.real B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (u eps eta : ℕ → ℝ) (n : ℕ) (hwin : PrimePairInitialWindowConditions L rho u eps eta n) : (∏ i ∈ range n, primePairStepCost (eps i) (eta i)) ≤ ∑ x ∈ primeBandSelections (fun i : Fin n ↦ primeLogWindow (u i.val) ((1 + eps i.val) * u i.val)), (∏ i, primeTiltWeight (primeLogWindow (u i.val) ((1 + eps i.val) * u i.val)) lam (x i)) * (if PrimePairInitialSuccess L rho (32 * primeLogOddsErrorConstant) B n x then 1 else 0) := by classical let P : ℕ → Finset ℕ := fun i ↦ primeLogWindow (u i) ((1 + eps i) * u i) change (∏ i ∈ range n, primePairStepCost (eps i) (eta i)) ≤ ∑ x ∈ Fintype.piFinset (fun i : Fin n ↦ (P i.val).powerset), (∏ i, primeTiltWeight (P i.val) lam (x i)) * (if PrimePairInitialSuccess L rho (32 * primeLogOddsErrorConstant) B n x then 1 else 0) apply finite_adaptive_prefix_lower (fun i ↦ (P i).powerset) (fun i T ↦ primeTiltWeight (P i) lam T) (fun i ↦ primePairStepCost (eps i) (eta i)) (PrimePairInitialSuccess L rho (32 * primeLogOddsErrorConstant) B) · intro i T _ exact (primeTiltWeight_pos (fun p hp ↦ (mem_primeLogWindow.mp hp).1) (by linarith : 0 < lam) T).le · intro x exact ⟨B, PrimePairInitialPath.initial x⟩ · intro i hi have heta := (hwin i hi).2.2.2.2.1 unfold primePairStepCost positivity · intro i hi x _ hx obtain ⟨A, hpath⟩ := hx obtain ⟨hui, hepsi, hepsi1, hlarge, hetai, hmargin, hwidth⟩ := hwin i hi let StepGood : Finset ℕ → Prop := fun T ↦ T.card = 2 ∧ PrimePairInitialEvent A B L rho (32 * primeLogOddsErrorConstant) T have hlocal : primePairStepCost (eps i) (eta i) ≤ ∑ T ∈ (P i).powerset.filter StepGood, primeTiltWeight (P i) lam T := primeTilt_initial_coverage_step (hpath.isCompact hB) hB hL hrho hBI hBvol hlam hlam2 hui hepsi hepsi1 hlarge hwidth hetai hmargin have hext (T : Finset ℕ) (hT : StepGood T) : PrimePairInitialSuccess L rho (32 * primeLogOddsErrorConstant) B (i + 1) (Fin.snoc x T) := by obtain ⟨hc, p, hp, q, hq, hh⟩ := hT exact ⟨_, PrimePairInitialPath.step hpath hc hp hq hh⟩ apply hlocal.trans rw [sum_filter] apply sum_le_sum intro T _ have hwT : 0 ≤ primeTiltWeight (P i) lam T := (primeTiltWeight_pos (fun p hp ↦ (mem_primeLogWindow.mp hp).1) (by linarith : 0 < lam) T).le change (if StepGood T then primeTiltWeight (P i) lam T else 0) ≤ primeTiltWeight (P i) lam T * (if PrimePairInitialSuccess L rho (32 * primeLogOddsErrorConstant) B (i + 1) (Fin.snoc x T) then 1 else 0) by_cases hT : StepGood T · simp only [if_pos hT, if_pos (hext T hT), mul_one, le_refl] · simp only [if_neg hT] exact mul_nonneg hwT (by split_ifs <;> norm_num) theorem primeTilt_ambient_initial_coverage {B : Set ℝ} (hB : IsCompact B) {L rho lam : ℝ} (hL : 0 < L) (hrho : 0 ≤ rho) (hBI : B ⊆ Set.Icc 0 L) (hBvol : rho * L ≤ volume.real B) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (u eps eta : ℕ → ℝ) (n : ℕ) (hwin : PrimePairInitialWindowConditions L rho u eps eta n) (hdis : Pairwise (fun i j : Fin n ↦ Disjoint (primeLogWindow (u i.val) ((1 + eps i.val) * u i.val)) (primeLogWindow (u j.val) ((1 + eps j.val) * u j.val)))) : (∏ i ∈ range n, primePairStepCost (eps i) (eta i)) ≤ ∑ T ∈ (primeBandUnion (fun i : Fin n ↦ primeLogWindow (u i.val) ((1 + eps i.val) * u i.val))).powerset, primeTiltWeight (primeBandUnion (fun i : Fin n ↦ primeLogWindow (u i.val) ((1 + eps i.val) * u i.val))) lam T * (if PrimePairInitialSuccess L rho (32 * primeLogOddsErrorConstant) B n (fun i ↦ T ∩ primeLogWindow (u i.val) ((1 + eps i.val) * u i.val)) then 1 else 0) := by classical rw [prime_tilt_expectation_primeBand_partition _ hdis lam (fun x ↦ if PrimePairInitialSuccess L rho (32 * primeLogOddsErrorConstant) B n x then 1 else 0)] exact primeTilt_independent_initial_coverage hB hL hrho hBI hBvol hlam hlam2 u eps eta n hwin theorem exists_prime_initial_coverage_length {rho : ℝ} (hrho : 0 < rho) : ∃ n : ℕ, (1 - rho / 32) ^ n ≤ 1 / (2 : ℝ) ^ 10 := by obtain ⟨n, hn⟩ := exists_pow_lt_of_lt_one (by positivity : (0 : ℝ) < 1 / (2 : ℝ) ^ 10) (by linarith : 1 - rho / 32 < 1) exact ⟨n, hn.le⟩ theorem PrimePairInitialSuccess.small_holes {L rho e : ℝ} {B : Set ℝ} {n : ℕ} {x : Fin n → Finset ℕ} (h : PrimePairInitialSuccess L rho e B n x) (hB : IsCompact B) (hL : 0 ≤ L) (hrho : rho ≤ 32) (hn : (1 - rho / 32) ^ n ≤ 1 / (2 : ℝ) ^ 10) : ∃ A, IsCompact A ∧ B ⊆ A ∧ PrimePairInitialPath L rho e B n x A ∧ volume.real (Set.Icc 0 L \ A) ≤ L / (2 : ℝ) ^ 10 := by obtain ⟨A, hp⟩ := h refine ⟨A, hp.isCompact hB, hp.base_subset, hp, (hp.hole_bound hL hrho).trans ?_⟩ simpa only [div_eq_mul_inv, one_mul, mul_comm] using mul_le_mul_of_nonneg_right hn hL theorem PrimePairInitialSuccess.mesh {L rho e : ℝ} {B : Set ℝ} {n : ℕ} {x : Fin n → Finset ℕ} (h : PrimePairInitialSuccess L rho e B n x) (hL : 0 ≤ L) (hrho : rho ≤ 32) (he : 0 ≤ e) : (∀ i, (x i).card = 2) ∧ ∃ g : Fin n → ℝ, (∀ i, ∃ p ∈ x i, ∃ q ∈ x i, g i = log (p : ℝ) - log (q : ℝ)) ∧ volume.real (Set.Icc 0 L \ finiteThickenedTranslateSupport B univ g e) ≤ (1 - rho / 32) ^ n * L := by obtain ⟨A, hp⟩ := h obtain ⟨g, hg, hA⟩ := hp.geometry he refine ⟨hp.counts, g, hg, ?_⟩ apply le_trans _ (hp.hole_bound hL hrho) exact measureReal_mono (Set.sdiff_subset_sdiff_right hA) (measure_ne_top_of_subset Set.sdiff_subset isCompact_Icc.measure_ne_top) end Erdos859Verification end /- Inlined development module: FordOrderedCrossing.lean -/ section /- Measurable first-crossing cells for an ordered affine barrier. -/ open MeasureTheory Set open scoped ENNReal namespace Erdos859Verification def fordOrderedInterval (k : ℕ) (a b : ℝ) : Set (Fin k → ℝ) := Icc (fun _ ↦ a) (fun _ ↦ b) ∩ {x | Monotone x} theorem fordOrderedInterval_measurable (k : ℕ) (a b : ℝ) : MeasurableSet (fordOrderedInterval k a b) := measurableSet_Icc.inter isClosed_monotone.measurableSet theorem fordOrderedInterval_translate (k : ℕ) (a b : ℝ) : fordOrderedInterval k a b = (fun x : Fin k → ℝ ↦ x - (fun _ ↦ a)) ⁻¹' fordOrderedSimplex k (b - a) := by ext x constructor · intro hx refine ⟨⟨fun i ↦ ?_, fun i ↦ ?_⟩, ?_⟩ · exact sub_nonneg.mpr (hx.1.1 i) · exact sub_le_sub_right (hx.1.2 i) a · intro i j hij exact sub_le_sub_right (hx.2 hij) a · intro hx refine ⟨⟨fun i ↦ ?_, fun i ↦ ?_⟩, ?_⟩ · exact sub_nonneg.mp (hx.1.1 i) · exact (sub_le_sub_iff_right a).mp (hx.1.2 i) · intro i j hij exact (sub_le_sub_iff_right a).mp (hx.2 hij) theorem fordOrderedInterval_volume (k : ℕ) {a b : ℝ} (hab : a ≤ b) : volume (fordOrderedInterval k a b) = ENNReal.ofReal ((b - a) ^ k / (k.factorial : ℝ)) := by rw [fordOrderedInterval_translate] rw [(measurePreserving_sub_right (volume : Measure (Fin k → ℝ)) (fun _ ↦ a)).measure_preimage (fordOrderedSimplex_measurable k (b - a)).nullMeasurableSet] exact fordOrderedSimplex_volume k (sub_nonneg.mpr hab) def fordBarrier (k : ℕ) (u v : ℝ) : Set (Fin k → ℝ) := {x | ∀ i, (i.val : ℝ) + 1 - u ≤ v * x i} def fordBarrierGood (k : ℕ) (T u v : ℝ) : Set (Fin k → ℝ) := fordOrderedSimplex k T ∩ fordBarrier k u v def fordFirstCrossing {k : ℕ} (T u v : ℝ) (l : Fin k) : Set (Fin k → ℝ) := fordOrderedSimplex k T ∩ {x | v * x l < (l.val : ℝ) + 1 - u ∧ ∀ i, i < l → (i.val : ℝ) + 1 - u ≤ v * x i} theorem fordBarrier_measurable (k : ℕ) (u v : ℝ) : MeasurableSet (fordBarrier k u v) := by unfold fordBarrier simp only [ofPred_forall] exact MeasurableSet.iInter fun i ↦ measurableSet_le measurable_const (measurable_const.mul (measurable_pi_apply i)) theorem fordBarrierGood_measurable (k : ℕ) (T u v : ℝ) : MeasurableSet (fordBarrierGood k T u v) := (fordOrderedSimplex_measurable k T).inter (fordBarrier_measurable k u v) theorem fordFirstCrossing_measurable {k : ℕ} (T u v : ℝ) (l : Fin k) : MeasurableSet (fordFirstCrossing T u v l) := by have hprior : MeasurableSet {x : Fin k → ℝ | ∀ i, i < l → (i.val : ℝ) + 1 - u ≤ v * x i} := by simp only [ofPred_forall] exact MeasurableSet.iInter fun i ↦ MeasurableSet.iInter fun _ ↦ measurableSet_le measurable_const (measurable_const.mul (measurable_pi_apply i)) exact (fordOrderedSimplex_measurable k T).inter ((measurableSet_lt (measurable_const.mul (measurable_pi_apply l)) measurable_const).inter hprior) theorem fordFirstCrossing_pairwise_disjoint (k : ℕ) (T u v : ℝ) : Pairwise (fun i j : Fin k ↦ Disjoint (fordFirstCrossing T u v i) (fordFirstCrossing T u v j)) := by intro i j hij apply disjoint_left.mpr intro x hxi hxj rcases lt_or_gt_of_ne hij with hij | hji · exact (not_lt_of_ge (hxj.2.2 i hij)) hxi.2.1 · exact (not_lt_of_ge (hxi.2.2 j hji)) hxj.2.1 theorem fordFirstCrossing_iUnion (k : ℕ) (T u v : ℝ) : (⋃ l : Fin k, fordFirstCrossing T u v l) = fordOrderedSimplex k T \ fordBarrier k u v := by classical ext x constructor · intro hx obtain ⟨l, hl⟩ := mem_iUnion.mp hx exact ⟨hl.1, fun hg ↦ (not_lt_of_ge (hg l)) hl.2.1⟩ · rintro ⟨hx, hbad⟩ change ¬ ∀ i : Fin k, (i.val : ℝ) + 1 - u ≤ v * x i at hbad push Not at hbad let S := Finset.univ.filter fun i : Fin k ↦ v * x i < (i.val : ℝ) + 1 - u have hS : S.Nonempty := by obtain ⟨i, hi⟩ := hbad exact ⟨i, Finset.mem_filter.mpr ⟨Finset.mem_univ _, hi⟩⟩ let l := S.min' hS have hl : l ∈ S := Finset.min'_mem S hS refine mem_iUnion.mpr ⟨l, hx, (Finset.mem_filter.mp hl).2, ?_⟩ intro i hil by_contra! hi have hiS : i ∈ S := Finset.mem_filter.mpr ⟨Finset.mem_univ _, hi⟩ exact (not_le_of_gt hil) (Finset.min'_le S i hiS) /-- The ordered bad region is an actual finite disjoint sum of measurable crossing cells. -/ theorem fordFirstCrossing_volume_sum (k : ℕ) (T u v : ℝ) : volume (fordOrderedSimplex k T \ fordBarrier k u v) = ∑ l : Fin k, volume (fordFirstCrossing T u v l) := by rw [← fordFirstCrossing_iUnion] rw [measure_iUnion (fordFirstCrossing_pairwise_disjoint k T u v) (fordFirstCrossing_measurable T u v), tsum_fintype] theorem fordBarrier_volume_decomposition (k : ℕ) {T : ℝ} (hT : 0 ≤ T) (u v : ℝ) : volume (fordBarrierGood k T u v) + ∑ l : Fin k, volume (fordFirstCrossing T u v l) = ENNReal.ofReal (T ^ k / (k.factorial : ℝ)) := by rw [← fordFirstCrossing_volume_sum] rw [fordBarrierGood, measure_inter_add_sdiff _ (fordBarrier_measurable k u v)] exact fordOrderedSimplex_volume k hT /-- Lebesgue measure splits exactly at any chosen coordinate. -/ theorem ford_volume_insertNth {n : ℕ} (l : Fin (n + 1)) {S : Set (Fin (n + 1) → ℝ)} (hS : MeasurableSet S) : volume S = ∫⁻ t : ℝ, volume {x : Fin n → ℝ | l.insertNth t x ∈ S} := by have hp : MeasurePreserving (fun z : ℝ × (Fin n → ℝ) ↦ (l.insertNth z.1 z.2 : Fin (n + 1) → ℝ)) volume volume := (volume_preserving_piFinSuccAbove (fun _ : Fin (n + 1) ↦ ℝ) l).symm rw [← hp.measure_preimage hS.nullMeasurableSet, Measure.volume_eq_prod, Measure.prod_apply (hS.preimage hp.measurable)] rfl theorem fordFirstCrossing_volume_slice {n : ℕ} (T u v : ℝ) (l : Fin (n + 1)) : volume (fordFirstCrossing T u v l) = ∫⁻ t : ℝ, volume {x : Fin n → ℝ | l.insertNth t x ∈ fordFirstCrossing T u v l} := ford_volume_insertNth l (fordFirstCrossing_measurable T u v l) theorem fordFirstCrossing_slice_empty {n : ℕ} (T u v t : ℝ) (l : Fin (n + 1)) (ht : ¬ (0 ≤ t ∧ t ≤ T ∧ v * t < (l.val : ℝ) + 1 - u)) : {x : Fin n → ℝ | l.insertNth t x ∈ fordFirstCrossing T u v l} = ∅ := by apply eq_empty_iff_forall_notMem.mpr intro x hx apply ht have hzero := hx.1.1.1 l have hupper := hx.1.1.2 l have hfail := hx.2.1 simpa only [Fin.insertNth_apply_same] using And.intro hzero (And.intro hupper hfail) /-- Concatenation is a measure-preserving equivalence of the two coordinate blocks. -/ theorem ford_append_measurePreserving (l m : ℕ) : MeasurePreserving (fun z : (Fin l → ℝ) × (Fin m → ℝ) ↦ Fin.append z.1 z.2) volume volume := by let e := (MeasurableEquiv.sumPiEquivProdPi (fun _ : Fin l ⊕ Fin m ↦ ℝ)).symm let f := MeasurableEquiv.piCongrLeft (fun _ : Fin (l + m) ↦ ℝ) finSumFinEquiv have hp := (volume_measurePreserving_piCongrLeft (fun _ : Fin (l + m) ↦ ℝ) finSumFinEquiv).comp (volume_measurePreserving_sumPiEquivProdPi_symm (fun _ : Fin l ⊕ Fin m ↦ ℝ)) have heq : (fun z : (Fin l → ℝ) × (Fin m → ℝ) ↦ Fin.append z.1 z.2) = f ∘ e := by funext z i refine Fin.addCases (fun j ↦ ?_) (fun j ↦ ?_) i · simp [f, e, MeasurableEquiv.coe_piCongrLeft, Equiv.piCongrLeft_apply, finSumFinEquiv] rfl · simp [f, e, MeasurableEquiv.coe_piCongrLeft, Equiv.piCongrLeft_apply, finSumFinEquiv] rfl rw [heq] exact hp theorem ford_monotone_append_iff {l m : ℕ} (p : Fin l → ℝ) (q : Fin m → ℝ) : Monotone (Fin.append p q) ↔ Monotone p ∧ Monotone q ∧ ∀ i j, p i ≤ q j := by constructor · intro h refine ⟨?_, ?_, ?_⟩ · intro i j hij simpa using h (show Fin.castAdd m i ≤ Fin.castAdd m j from hij) · intro i j hij have hh : Fin.natAdd l i ≤ Fin.natAdd l j := by change l + i.val ≤ l + j.val exact Nat.add_le_add_left hij l simpa using h hh · intro i j have hh : Fin.castAdd m i ≤ Fin.natAdd l j := by change i.val ≤ l + j.val omega simpa using h hh · rintro ⟨hp, hq, hpq⟩ i refine Fin.addCases (fun a ↦ ?_) (fun a ↦ ?_) i · intro j refine Fin.addCases (fun b h ↦ ?_) (fun b _ ↦ ?_) j · simpa using hp h · simpa using hpq a b · intro j refine Fin.addCases (fun b h ↦ ?_) (fun b h ↦ ?_) j · change l + a.val ≤ b.val at h omega · have hab : a ≤ b := by change l + a.val ≤ l + b.val at h exact Nat.le_of_add_le_add_left h simpa using hq hab theorem ford_monotone_cons_iff {m : ℕ} (t : ℝ) (q : Fin m → ℝ) : Monotone (Fin.cons t q) ↔ Monotone q ∧ ∀ j, t ≤ q j := by constructor · intro h refine ⟨?_, ?_⟩ · intro i j hij simpa using h (Fin.succ_le_succ_iff.mpr hij) · intro j simpa using h (show (0 : Fin (m + 1)) ≤ j.succ from Fin.zero_le _) · rintro ⟨hq, htq⟩ i refine Fin.cases (fun j _ ↦ ?_) (fun a j ↦ ?_) i · exact Fin.cases (le_refl t) (fun b ↦ by simpa using htq b) j · refine Fin.cases (fun h ↦ ?_) (fun b h ↦ ?_) j · have hh : a.val + 1 ≤ 0 := h omega · simpa using hq (Fin.succ_le_succ_iff.mp h) /-- The ordered slice has exactly its constrained left block and free right block. -/ theorem ford_splice_simplex_iff {l m : ℕ} (p : Fin l → ℝ) (q : Fin m → ℝ) (t T : ℝ) : Fin.append p (Fin.cons t q) ∈ fordOrderedSimplex (l + (m + 1)) T ↔ 0 ≤ t ∧ t ≤ T ∧ p ∈ fordOrderedSimplex l t ∧ q ∈ fordOrderedInterval m t T := by constructor · intro hx have hm := (ford_monotone_append_iff p (Fin.cons t q)).mp hx.2 have hmq := (ford_monotone_cons_iff t q).mp hm.2.1 refine ⟨?_, ?_, ⟨⟨?_, ?_⟩, hm.1⟩, ⟨⟨hmq.2, ?_⟩, hmq.1⟩⟩ · simpa using hx.1.1 (Fin.natAdd l 0) · simpa using hx.1.2 (Fin.natAdd l 0) · intro i simpa using hx.1.1 (Fin.castAdd (m + 1) i) · intro i simpa using hm.2.2 i 0 · intro j simpa using hx.1.2 (Fin.natAdd l j.succ) · rintro ⟨ht0, htT, hp, hq⟩ refine ⟨⟨?_, ?_⟩, (ford_monotone_append_iff p (Fin.cons t q)).mpr ?_⟩ · intro i refine Fin.addCases (fun j ↦ ?_) (fun j ↦ ?_) i · simpa using hp.1.1 j · refine Fin.cases (by simpa using ht0) (fun j ↦ ?_) j simpa using ht0.trans (hq.1.1 j) · intro i refine Fin.addCases (fun j ↦ ?_) (fun j ↦ ?_) i · simpa using (hp.1.2 j).trans htT · refine Fin.cases (by simpa using htT) (fun j ↦ ?_) j simpa using hq.1.2 j · refine ⟨hp.2, (ford_monotone_cons_iff t q).mpr ⟨hq.2, hq.1.1⟩, ?_⟩ intro i j exact Fin.cases (by simpa using hp.1.2 i) (fun j ↦ by simpa using (hp.1.2 i).trans (hq.1.1 j)) j theorem ford_splice_crossing_iff {l m : ℕ} (p : Fin l → ℝ) (q : Fin m → ℝ) (t T u v : ℝ) : Fin.append p (Fin.cons t q) ∈ fordFirstCrossing T u v (Fin.natAdd l 0) ↔ (0 ≤ t ∧ t ≤ T ∧ v * t < (l : ℝ) + 1 - u) ∧ p ∈ fordBarrierGood l t u v ∧ q ∈ fordOrderedInterval m t T := by constructor · intro hx obtain ⟨ht0, htT, hp, hq⟩ := (ford_splice_simplex_iff p q t T).mp hx.1 refine ⟨⟨ht0, htT, ?_⟩, ⟨hp, ?_⟩, hq⟩ · simpa using hx.2.1 · intro i have hi : Fin.castAdd (m + 1) i < Fin.natAdd l (0 : Fin (m + 1)) := by change i.val < l + 0 simp simpa using hx.2.2 (Fin.castAdd (m + 1) i) hi · rintro ⟨⟨ht0, htT, hfail⟩, hp, hq⟩ refine ⟨(ford_splice_simplex_iff p q t T).mpr ⟨ht0, htT, hp.1, hq⟩, ?_, ?_⟩ · simpa using hfail · intro i refine Fin.addCases (fun j _ ↦ ?_) (fun j hj ↦ ?_) i · simpa using hp.2 j · change l + j.val < l + 0 at hj omega theorem ford_splice_measurePreserving (l m : ℕ) : MeasurePreserving (fun z : ℝ × ((Fin l → ℝ) × (Fin m → ℝ)) ↦ Fin.append z.2.1 (Fin.cons z.1 z.2.2)) volume volume := by have hleft : MeasurePreserving (MeasurableEquiv.prodAssoc.symm : ℝ × ((Fin l → ℝ) × (Fin m → ℝ)) ≃ᵐ (ℝ × (Fin l → ℝ)) × (Fin m → ℝ)) volume volume := volume_preserving_prodAssoc.symm have hswap : MeasurePreserving (Prod.swap : ℝ × (Fin l → ℝ) → (Fin l → ℝ) × ℝ) volume volume := Measure.measurePreserving_swap have hright : MeasurePreserving (MeasurableEquiv.prodAssoc : ((Fin l → ℝ) × ℝ) × (Fin m → ℝ) ≃ᵐ (Fin l → ℝ) × (ℝ × (Fin m → ℝ))) volume volume := volume_preserving_prodAssoc have hreorder := hright.comp ((hswap.prod (MeasurePreserving.id volume)).comp hleft) have hcons : MeasurePreserving (fun z : ℝ × (Fin m → ℝ) ↦ (Fin.cons z.1 z.2 : Fin (m + 1) → ℝ)) volume volume := by simpa only [MeasurableEquiv.piFinSuccAbove_symm_apply, Fin.insertNthEquiv, Equiv.coe_fn_mk, Fin.insertNth_zero'] using (volume_preserving_piFinSuccAbove (fun _ : Fin (m + 1) ↦ ℝ) 0).symm exact ((ford_append_measurePreserving l (m + 1)).comp ((MeasurePreserving.id volume).prod hcons)).comp hreorder /-- Exact first-crossing fiber formula, including its genuine prefix barrier volume. -/ theorem fordFirstCrossing_volume_prefix_suffix (l m : ℕ) (T u v : ℝ) : volume (fordFirstCrossing (k := l + (m + 1)) T u v (Fin.natAdd l 0)) = ∫⁻ t : ℝ, if 0 ≤ t ∧ t ≤ T ∧ v * t < (l : ℝ) + 1 - u then volume (fordBarrierGood l t u v) * ENNReal.ofReal ((T - t) ^ m / (m.factorial : ℝ)) else 0 := by classical have hS := fordFirstCrossing_measurable (k := l + (m + 1)) T u v (Fin.natAdd l 0) have hp := ford_splice_measurePreserving l m rw [← hp.measure_preimage hS.nullMeasurableSet, Measure.volume_eq_prod, Measure.prod_apply (hS.preimage hp.measurable)] apply lintegral_congr intro t by_cases ht : 0 ≤ t ∧ t ≤ T ∧ v * t < (l : ℝ) + 1 - u · rw [if_pos ht] have heq : {z : (Fin l → ℝ) × (Fin m → ℝ) | Fin.append z.1 (Fin.cons t z.2) ∈ fordFirstCrossing T u v (Fin.natAdd l 0)} = fordBarrierGood l t u v ×ˢ fordOrderedInterval m t T := by ext z simp only [mem_ofPred_eq, ford_splice_crossing_iff, ht, true_and, mem_prod] change volume {z : (Fin l → ℝ) × (Fin m → ℝ) | Fin.append z.1 (Fin.cons t z.2) ∈ fordFirstCrossing T u v (Fin.natAdd l 0)} = _ rw [heq, Measure.volume_eq_prod, Measure.prod_prod, fordOrderedInterval_volume m ht.2.1] · rw [if_neg ht] have heq : {z : (Fin l → ℝ) × (Fin m → ℝ) | Fin.append z.1 (Fin.cons t z.2) ∈ fordFirstCrossing T u v (Fin.natAdd l 0)} = ∅ := by ext z simp only [mem_ofPred_eq, ford_splice_crossing_iff, ht, false_and, mem_empty_iff_false] change volume {z : (Fin l → ℝ) × (Fin m → ℝ) | Fin.append z.1 (Fin.cons t z.2) ∈ fordFirstCrossing T u v (Fin.natAdd l 0)} = 0 rw [heq, measure_empty] /-- Positive `v` turns the failure condition into the explicit crossing threshold. -/ theorem fordFirstCrossing_volume_integral (l m : ℕ) (T u : ℝ) {v : ℝ} (hv : 0 < v) : volume (fordFirstCrossing (k := l + (m + 1)) T u v (Fin.natAdd l 0)) = ∫⁻ t : ℝ in Icc 0 T ∩ Iio (((l : ℝ) + 1 - u) / v), volume (fordBarrierGood l t u v) * ENNReal.ofReal ((T - t) ^ m / (m.factorial : ℝ)) := by classical rw [fordFirstCrossing_volume_prefix_suffix, ← lintegral_indicator (measurableSet_Icc.inter measurableSet_Iio)] apply lintegral_congr intro t simp only [indicator_apply, mem_inter_iff, mem_Icc, mem_Iio, lt_div_iff₀ hv, mul_comm t v, and_assoc] end Erdos859Verification end /- Inlined development module: FordBarrierBound.lean -/ section /- Actual ordered-barrier endpoint comparison and Ford's main-regime bound. -/ open MeasureTheory Set Real open scoped ENNReal namespace Erdos859Verification theorem fordBarrierGood_prefix_lower {l : ℕ} {t u v : ℝ} (hu : 0 ≤ u) (hv : 0 ≤ v) (ht : 0 ≤ t) (hvol : volume (fordBarrierGood l t u v) ≠ 0) : (l : ℝ) - u ≤ v * t := by cases l with | zero => simp only [Nat.cast_zero, zero_sub]; nlinarith | succ l => obtain ⟨x, hx⟩ := nonempty_of_measure_ne_zero hvol have hb := hx.2 (Fin.last l) have ht' := mul_le_mul_of_nonneg_left (hx.1.1.2 (Fin.last l)) hv simp only [Fin.val_last, Nat.cast_add, Nat.cast_one] at hb ⊢ linarith /-- The genuine crossing slack makes the free suffix shrink by `exp (-(2w+2))`. -/ theorem ford_crossing_suffix_power_le {l m : ℕ} {t u v w : ℝ} (hw : 0 ≤ w) (hv : 0 < v) (hrel : v = (l + (m + 1) : ℕ) + w - u) (ht : t ≤ 1 - (2 * w + 2) / v) (hprefix : (l : ℝ) - u ≤ v * t) (hfail : v * t < (l : ℝ) + 1 - u) : (1 - (2 * w + 2) / v - t) ^ m ≤ exp (-(2 * w + 2)) * (1 - t) ^ m := by have hvt : v * t ≤ v - (2 * w + 2) := by have h := mul_le_mul_of_nonneg_left ht hv.le have heq : v * (1 - (2 * w + 2) / v) = v - (2 * w + 2) := by field_simp rwa [heq] at h have hrel' : v = (l : ℝ) + (m : ℝ) + 1 + w - u := by norm_num only [Nat.cast_add, Nat.cast_one] at hrel linarith have hm : 0 < m := by by_contra h have hm0 : m = 0 := Nat.eq_zero_of_not_pos h simp only [hm0, Nat.cast_zero] at hrel' linarith let lam := (l : ℝ) + 1 - u - v * t let A := w + 2 - lam let B := w + lam have hlam0 : 0 < lam := by dsimp [lam]; linarith have hlam1 : lam ≤ 1 := by dsimp [lam]; linarith have hB : 0 ≤ B := by dsimp [B]; linarith have hBA : B ≤ A := by dsimp [A, B]; linarith have hAm : A ≤ m := by dsimp [A, lam]; linarith have hratio := ford_power_ratio_upper hm hB hBA hAm have hden : 0 < 1 - t := by have hc : 0 < (2 * w + 2) / v := by positivity linarith have hmB : 0 < (m : ℝ) + B := by have hmR : (0 : ℝ) < m := by exact_mod_cast hm linarith have htop : v * (1 - (2 * w + 2) / v - t) = (m : ℝ) - A := by dsimp [A, lam] field_simp nlinarith [hrel'] have hbot : v * (1 - t) = (m : ℝ) + B := by dsimp [B, lam]; nlinarith have heq : (1 - (2 * w + 2) / v - t) / (1 - t) = ((m : ℝ) - A) / ((m : ℝ) + B) := by rw [← htop, ← hbot] field_simp have hexp : -A - B = -(2 * w + 2) := by dsimp [A, B]; ring rw [hexp, ← heq, div_pow] at hratio exact (div_le_iff₀ (pow_pos hden m)).mp hratio /-- Comparison of actual first-crossing cell volumes at the two endpoints. -/ theorem fordFirstCrossing_short_le {l m : ℕ} {u v w : ℝ} (hu : 0 ≤ u) (hw : 0 ≤ w) (hv : 0 < v) (hrel : v = (l + (m + 1) : ℕ) + w - u) : volume (fordFirstCrossing (k := l + (m + 1)) (1 - (2 * w + 2) / v) u v (Fin.natAdd l 0)) ≤ ENNReal.ofReal (exp (-(2 * w + 2))) * volume (fordFirstCrossing (k := l + (m + 1)) 1 u v (Fin.natAdd l 0)) := by classical rw [fordFirstCrossing_volume_prefix_suffix, fordFirstCrossing_volume_prefix_suffix, ← lintegral_const_mul' _ _ ENNReal.ofReal_ne_top] apply lintegral_mono intro t dsimp only by_cases ht : 0 ≤ t ∧ t ≤ 1 - (2 * w + 2) / v ∧ v * t < (l : ℝ) + 1 - u · rw [if_pos ht] have ht1 : 0 ≤ t ∧ t ≤ 1 ∧ v * t < (l : ℝ) + 1 - u := by have hc : 0 ≤ (2 * w + 2) / v := by positivity exact ⟨ht.1, by linarith [ht.2.1], ht.2.2⟩ rw [if_pos ht1] by_cases hzero : volume (fordBarrierGood l t u v) = 0 · simp [hzero] · have hprefix := fordBarrierGood_prefix_lower hu hv.le ht.1 hzero have hpow := ford_crossing_suffix_power_le hw hv hrel ht.2.1 hprefix ht.2.2 have hdiv := div_le_div_of_nonneg_right hpow (by positivity : (0 : ℝ) ≤ m.factorial) have hfactor : ENNReal.ofReal ((1 - (2 * w + 2) / v - t) ^ m / (m.factorial : ℝ)) ≤ ENNReal.ofReal (exp (-(2 * w + 2))) * ENNReal.ofReal ((1 - t) ^ m / (m.factorial : ℝ)) := by rw [← ENNReal.ofReal_mul (exp_pos _).le] apply ENNReal.ofReal_le_ofReal simpa only [mul_div_assoc] using hdiv calc _ ≤ volume (fordBarrierGood l t u v) * (ENNReal.ofReal (exp (-(2 * w + 2))) * ENNReal.ofReal ((1 - t) ^ m / (m.factorial : ℝ))) := mul_le_mul_of_nonneg_left hfactor (by positivity) _ = _ := by ring · rw [if_neg ht] exact bot_le theorem fordFirstCrossing_short_le_index {k : ℕ} (l : Fin k) {u v w : ℝ} (hu : 0 ≤ u) (hw : 0 ≤ w) (hv : 0 < v) (hrel : v = (k : ℝ) + w - u) : volume (fordFirstCrossing (1 - (2 * w + 2) / v) u v l) ≤ ENNReal.ofReal (exp (-(2 * w + 2))) * volume (fordFirstCrossing 1 u v l) := by rcases l with ⟨a, ha⟩ obtain ⟨m, rfl⟩ : ∃ m, k = a + (m + 1) := ⟨k - a - 1, by omega⟩ have hi : (⟨a, ha⟩ : Fin (a + (m + 1))) = Fin.natAdd a 0 := by ext; simp rw [hi] exact fordFirstCrossing_short_le hu hw hv hrel theorem fordBarrier_bad_short_le {k : ℕ} {u v w : ℝ} (hu : 0 ≤ u) (hw : 0 ≤ w) (hv : 0 < v) (hrel : v = (k : ℝ) + w - u) : volume (fordOrderedSimplex k (1 - (2 * w + 2) / v) \ fordBarrier k u v) ≤ ENNReal.ofReal (exp (-(2 * w + 2))) * volume (fordOrderedSimplex k 1 \ fordBarrier k u v) := by rw [fordFirstCrossing_volume_sum, fordFirstCrossing_volume_sum, Finset.mul_sum] exact Finset.sum_le_sum fun l _ ↦ fordFirstCrossing_short_le_index l hu hw hv hrel theorem fordBarrierGood_short_empty {k : ℕ} (hk : 0 < k) {u v w : ℝ} (hw : 0 ≤ w) (hv : 0 < v) (hrel : v = (k : ℝ) + w - u) : fordBarrierGood k (1 - (2 * w + 2) / v) u v = ∅ := by cases k with | zero => omega | succ k => apply eq_empty_iff_forall_notMem.mpr intro x hx have hb := hx.2 (Fin.last k) have ht := mul_le_mul_of_nonneg_left (hx.1.1.2 (Fin.last k)) hv.le have heq : v * (1 - (2 * w + 2) / v) = v - (2 * w + 2) := by field_simp rw [heq] at ht simp only [Fin.val_last, Nat.cast_add, Nat.cast_one] at hb hrel linarith theorem fordOrderedSimplex_volume_ne_top (k : ℕ) (T : ℝ) : volume (fordOrderedSimplex k T) ≠ ∞ := measure_ne_top_of_subset inter_subset_left isCompact_Icc.measure_lt_top.ne theorem fordBarrierGood_volume_ne_top (k : ℕ) (T u v : ℝ) : volume (fordBarrierGood k T u v) ≠ ∞ := measure_ne_top_of_subset inter_subset_left (fordOrderedSimplex_volume_ne_top k T) theorem fordBarrier_bad_volume_ne_top (k : ℕ) (T u v : ℝ) : volume (fordOrderedSimplex k T \ fordBarrier k u v) ≠ ∞ := measure_ne_top_of_subset sdiff_subset (fordOrderedSimplex_volume_ne_top k T) /-- The normalized ordered barrier volume is controlled by the shortened-cube margin. -/ theorem fordBarrier_endpoint_bound {k : ℕ} (hk : 0 < k) {u v w : ℝ} (hu : 0 ≤ u) (hw : 0 ≤ w) (hv : 0 < v) (hrel : v = (k : ℝ) + w - u) (hshort : 0 ≤ 1 - (2 * w + 2) / v) : (k.factorial : ℝ) * (volume (fordBarrierGood k 1 u v)).toReal ≤ 1 - exp (2 * w + 2) * (1 - (2 * w + 2) / v) ^ k := by have hbad := fordBarrier_bad_short_le hu hw hv hrel have hshortvol := fordBarrier_volume_decomposition k hshort u v rw [fordBarrierGood_short_empty hk hw hv hrel, measure_empty, zero_add, ← fordFirstCrossing_volume_sum] at hshortvol rw [hshortvol] at hbad have hreal := ENNReal.toReal_mono (ENNReal.mul_ne_top ENNReal.ofReal_ne_top (fordBarrier_bad_volume_ne_top k 1 u v)) hbad rw [ENNReal.toReal_ofReal (by positivity), ENNReal.toReal_mul, ENNReal.toReal_ofReal (exp_pos _).le] at hreal have hfull := congrArg ENNReal.toReal (fordBarrier_volume_decomposition k (by norm_num : (0 : ℝ) ≤ 1) u v) rw [← fordFirstCrossing_volume_sum, ENNReal.toReal_add (fordBarrierGood_volume_ne_top k 1 u v) (fordBarrier_bad_volume_ne_top k 1 u v), ENNReal.toReal_ofReal (by positivity), one_pow] at hfull have hcancel : exp (2 * w + 2) * exp (-(2 * w + 2)) = 1 := by rw [← exp_add, add_neg_cancel, exp_zero] have hfac : (0 : ℝ) < k.factorial := by positivity have hm := mul_le_mul_of_nonneg_left hreal (exp_pos (2 * w + 2)).le have hm' : exp (2 * w + 2) * ((1 - (2 * w + 2) / v) ^ k / (k.factorial : ℝ)) ≤ (volume (fordOrderedSimplex k 1 \ fordBarrier k u v)).toReal := by simpa only [← mul_assoc, hcancel, one_mul] using hm have hf := mul_le_mul_of_nonneg_left hm' hfac.le have hid : (k.factorial : ℝ) * (exp (2 * w + 2) * ((1 - (2 * w + 2) / v) ^ k / (k.factorial : ℝ))) = exp (2 * w + 2) * (1 - (2 * w + 2) / v) ^ k := by field_simp rw [hid] at hf have hfull' := congrArg (fun x : ℝ ↦ (k.factorial : ℝ) * x) hfull have hid' : (k.factorial : ℝ) * (1 / (k.factorial : ℝ)) = 1 := by field_simp rw [mul_add, hid'] at hfull' linarith /-- Ford's barrier estimate in the main regime, for the actual ordered set. -/ theorem fordBarrier_main_regime_bound {k : ℕ} (hk : 0 < k) {u v w : ℝ} (hu : 0 ≤ u) (hw : 0 ≤ w) (hrel : v = (k : ℝ) + w - u) (hkv : (k : ℝ) / 2 ≤ v) (hsmall : 2 * (2 * w + 2) ≤ v) : (k.factorial : ℝ) * (volume (fordBarrierGood k 1 u v)).toReal ≤ 36 * (u + 1) * (w + 1) ^ 2 / k := by have hkR : (0 : ℝ) < k := by exact_mod_cast hk have hv : 0 < v := by linarith have hshort : 0 ≤ 1 - (2 * w + 2) / v := by have hq : (2 * w + 2) / v ≤ 1 := (div_le_one hv).mpr (by linarith) linarith exact (fordBarrier_endpoint_bound hk hu hw hv hrel hshort).trans (ford_barrier_final_margin hk hu hw hrel hkv hsmall) theorem fordBarrier_normalized_volume_le_one (k : ℕ) (u v : ℝ) : (k.factorial : ℝ) * (volume (fordBarrierGood k 1 u v)).toReal ≤ 1 := by have h := ENNReal.toReal_mono (fordOrderedSimplex_volume_ne_top k 1) (measure_mono (show fordBarrierGood k 1 u v ⊆ fordOrderedSimplex k 1 from inter_subset_left)) rw [fordOrderedSimplex_volume k (by norm_num : (0 : ℝ) ≤ 1), one_pow, ENNReal.toReal_ofReal (by positivity)] at h calc _ ≤ (k.factorial : ℝ) * (1 / (k.factorial : ℝ)) := mul_le_mul_of_nonneg_left h (Nat.cast_nonneg _) _ = 1 := by field_simp /-- The normalized ordered barrier bound holds in every regime, with an absolute constant. -/ theorem fordBarrier_bound {k : ℕ} (hk : 0 < k) {u v w : ℝ} (hu : 0 ≤ u) (hw : 0 ≤ w) (hrel : v = (k : ℝ) + w - u) : (k.factorial : ℝ) * (volume (fordBarrierGood k 1 u v)).toReal ≤ 36 * (u + 1) * (w + 1) ^ 2 / k := by have hkR : (0 : ℝ) < k := by exact_mod_cast hk by_cases hkv : (k : ℝ) / 2 ≤ v · by_cases hsmall : 2 * (2 * w + 2) ≤ v · exact fordBarrier_main_regime_bound hk hu hw hrel hkv hsmall · apply (fordBarrier_normalized_volume_le_one k u v).trans apply (le_div_iff₀ hkR).mpr have hp : u + 3 * w + 4 ≤ 4 * (u + 1) * (w + 1) ^ 2 := by nlinarith [mul_nonneg hu (sq_nonneg w), mul_nonneg hu hw, sq_nonneg w] have hprod : 0 ≤ (u + 1) * (w + 1) ^ 2 := by positivity linarith · apply (fordBarrier_normalized_volume_le_one k u v).trans apply (le_div_iff₀ hkR).mpr have hp : u + 1 ≤ (u + 1) * (w + 1) ^ 2 := by nlinarith [mul_nonneg (show 0 ≤ u + 1 by linarith) (show 0 ≤ (w + 1) ^ 2 - 1 by nlinarith)] linarith end Erdos859Verification end /- Inlined development module: CoreBlockOverhead.lean -/ section /- Finite accumulation of translated-block errors with decreasing head parameters. -/ namespace Erdos859Verification open Finset Real def coreBlockHead (J h b : ℕ) : ℕ := J - b * h theorem coreBlockHead_admissible {A B : ℝ} (_hB : 0 < B) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) (h b : ℕ) : A / (B * (2 : ℝ) ^ (b * h)) ≤ (2 : ℝ) ^ coreBlockHead J h b := by rw [div_mul_eq_div_div] by_cases hbh : b * h ≤ J · rw [coreBlockHead, pow_sub₀ _ (by norm_num : (2 : ℝ) ≠ 0) hbh, ← div_eq_mul_inv] exact div_le_div_of_nonneg_right hAB (by positivity) · have hpow : (2 : ℝ) ^ J ≤ 2 ^ (b * h) := pow_le_pow_right₀ (by norm_num) (by omega) simp only [coreBlockHead, Nat.sub_eq_zero_of_le (by omega : J ≤ b * h), pow_zero] exact (div_le_one (by positivity)).mpr (hAB.trans hpow) theorem coreBlockHead_eq_zero_of_ge_div {J h b : ℕ} (hh : 0 < h) (hb : J / h + 1 ≤ b) : coreBlockHead J h b = 0 := by have hdiv : J / h < b := by omega have hJ : J < b * h := (Nat.div_lt_iff_lt_mul hh).mp hdiv exact Nat.sub_eq_zero_of_le hJ.le theorem log_one_add_le_dyadic {x : ℝ} (hx : 0 ≤ x) {J : ℕ} (hxJ : x ≤ (2 : ℝ) ^ J) : log (1 + x) ≤ (J + 1 : ℕ) * log 2 := by have hp : (1 : ℝ) ≤ 2 ^ J := one_le_pow₀ (by norm_num) have hu : 1 + x ≤ (2 : ℝ) ^ (J + 1) := by rw [pow_succ]; linarith simpa only [log_pow] using log_le_log (by positivity) hu theorem coreBlockHead_log_sum_le {A B : ℝ} (hA : 0 ≤ A) (hB : 0 < B) {J h : ℕ} (hh : 0 < h) (hAB : A / B ≤ (2 : ℝ) ^ J) (r : ℕ) : (∑ b ∈ range r, (coreBlockHead J h b : ℝ) * log (1 + A / (B * (2 : ℝ) ^ (b * h)))) ≤ (min r (J / h + 1) : ℕ) * (J : ℝ) * (J + 1 : ℕ) * log 2 := by let f : ℕ → ℝ := fun b ↦ (coreBlockHead J h b : ℝ) * log (1 + A / (B * (2 : ℝ) ^ (b * h))) have hcut : (∑ b ∈ range r, f b) = ∑ b ∈ range (min r (J / h + 1)), f b := by symm apply sum_subset (fun b hb ↦ mem_range.mpr ((mem_range.mp hb).trans_le (min_le_left _ _))) intro b hb hnot have hlarge : J / h + 1 ≤ b := by have := mem_range.mp hb have hnot' : ¬ b < min r (J / h + 1) := by simpa only [mem_range] using hnot omega simp only [f, coreBlockHead_eq_zero_of_ge_div hh hlarge, Nat.cast_zero, zero_mul] have hterm (b : ℕ) : f b ≤ (J : ℝ) * (J + 1 : ℕ) * log 2 := by have hx : 0 ≤ A / (B * (2 : ℝ) ^ (b * h)) := by positivity have hhead : coreBlockHead J h b ≤ J := Nat.sub_le _ _ have hxJ := (coreBlockHead_admissible hB hAB h b).trans (pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 2) hhead) have hlog := log_one_add_le_dyadic hx hxJ have hheadR : (coreBlockHead J h b : ℝ) ≤ J := by exact_mod_cast hhead have hm := mul_le_mul hheadR hlog (log_nonneg (by linarith)) (Nat.cast_nonneg J) simpa only [f, mul_assoc] using hm change (∑ b ∈ range r, f b) ≤ _ rw [hcut] calc _ ≤ ∑ _b ∈ range (min r (J / h + 1)), (J : ℝ) * (J + 1 : ℕ) * log 2 := sum_le_sum (fun b _ ↦ hterm b) _ = _ := by simp only [sum_const, card_range, nsmul_eq_mul]; ring theorem sum_dyadic_stride_reciprocal_le {h : ℕ} (hh : 0 < h) (r : ℕ) : (∑ b ∈ range r, 1 / (2 : ℝ) ^ (b * h)) ≤ 2 := by have hgeom : (∑ b ∈ range r, ((1 : ℝ) / 2) ^ b) ≤ 2 := by have h := geom_sum_Ico_le_of_lt_one (m := 0) (n := r) (by norm_num : (0 : ℝ) ≤ 1 / 2) (by norm_num : (1 : ℝ) / 2 < 1) norm_num at h ⊢ exact h apply le_trans _ hgeom apply sum_le_sum intro b _ have hbh : b ≤ b * h := by simpa only [Nat.mul_one] using Nat.mul_le_mul_left b (by omega : 1 ≤ h) have hp : (2 : ℝ) ^ b ≤ 2 ^ (b * h) := pow_le_pow_right₀ (by norm_num) hbh simpa only [div_pow, one_pow] using one_div_le_one_div_of_le (by positivity) hp theorem coreBlock_reciprocal_error_sum_le {A B : ℝ} (hA : 0 ≤ A) (hB : 0 < B) {h : ℕ} (hh : 0 < h) (r : ℕ) : (∑ b ∈ range r, 1 / (A + B * (2 : ℝ) ^ (b * h))) ≤ 2 / B := by calc _ ≤ ∑ b ∈ range r, (1 / B) * (1 / (2 : ℝ) ^ (b * h)) := by apply sum_le_sum intro b _ calc _ ≤ 1 / (B * (2 : ℝ) ^ (b * h)) := one_div_le_one_div_of_le (by positivity) (by linarith) _ = _ := by field_simp _ = (1 / B) * ∑ b ∈ range r, 1 / (2 : ℝ) ^ (b * h) := (mul_sum _ _ _).symm _ ≤ (1 / B) * 2 := mul_le_mul_of_nonneg_left (sum_dyadic_stride_reciprocal_le hh r) (by positivity) _ = _ := by ring theorem virtualPrimeRelativeError_dyadic_scale {B : ℝ} (hB : 0 < B) (j : ℕ) : virtualPrimeRelativeError (B * (2 : ℝ) ^ j) = virtualPrimeRelativeError B * (1 / (2 : ℝ) ^ j) := by have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) unfold virtualPrimeRelativeError field_simp theorem coreBlock_relative_error_sum_le {B : ℝ} (hB : 0 < B) {h : ℕ} (hh : 0 < h) (r : ℕ) : (∑ b ∈ range r, virtualPrimeRelativeError (B * (2 : ℝ) ^ (b * h))) ≤ 2 * virtualPrimeRelativeError B := by have hxi : 0 ≤ virtualPrimeRelativeError B := by unfold virtualPrimeRelativeError positivity [primeLogOddsErrorConstant_pos, log_pos (by norm_num : (1 : ℝ) < 2)] simp only [virtualPrimeRelativeError_dyadic_scale hB, ← mul_sum] simpa only [mul_comm] using mul_le_mul_of_nonneg_left (sum_dyadic_stride_reciprocal_le hh r) hxi theorem coreBlock_prefix_correction_sum_le {A B lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hlam : 0 ≤ lam) {J h : ℕ} (hh : 0 < h) (hAB : A / B ≤ (2 : ℝ) ^ J) (n r : ℕ) : (∑ b ∈ range r, (2 * lam * primeLogOddsErrorConstant / (A + B * (2 : ℝ) ^ (b * h)) + (coreBlockHead J h b : ℝ) * log (1 + A / (B * (2 : ℝ) ^ (b * h))) + 2 + 2 * (n : ℝ) * virtualPrimeRelativeError (B * (2 : ℝ) ^ (b * h)))) ≤ 4 * lam * primeLogOddsErrorConstant / B + (min r (J / h + 1) : ℕ) * (J : ℝ) * (J + 1 : ℕ) * log 2 + 2 * (r : ℝ) + 4 * (n : ℝ) * virtualPrimeRelativeError B := by have hfirst : (∑ b ∈ range r, 2 * lam * primeLogOddsErrorConstant / (A + B * (2 : ℝ) ^ (b * h))) ≤ 4 * lam * primeLogOddsErrorConstant / B := by calc _ = (2 * lam * primeLogOddsErrorConstant) * ∑ b ∈ range r, 1 / (A + B * (2 : ℝ) ^ (b * h)) := by rw [mul_sum] apply sum_congr rfl intro b _ ring _ ≤ (2 * lam * primeLogOddsErrorConstant) * (2 / B) := mul_le_mul_of_nonneg_left (coreBlock_reciprocal_error_sum_le hA hB hh r) (by positivity [primeLogOddsErrorConstant_pos]) _ = _ := by ring have hlast : (∑ b ∈ range r, 2 * (n : ℝ) * virtualPrimeRelativeError (B * (2 : ℝ) ^ (b * h))) ≤ 4 * (n : ℝ) * virtualPrimeRelativeError B := by rw [← mul_sum] have h := mul_le_mul_of_nonneg_left (coreBlock_relative_error_sum_le hB hh r) (by positivity : 0 ≤ 2 * (n : ℝ)) calc _ ≤ 2 * (n : ℝ) * (2 * virtualPrimeRelativeError B) := h _ = _ := by ring simp only [sum_add_distrib, sum_const, card_range, nsmul_eq_mul] have hhead := coreBlockHead_log_sum_le hA hB hh hAB r linarith theorem core_log_shift_loss_sum_le {x : ℝ} (hx : 0 ≤ x) {J : ℕ} (hxJ : x ≤ (2 : ℝ) ^ J) (N : ℕ) : (∑ l ∈ range N, log (1 + x / (2 : ℝ) ^ l)) ≤ ((J + 1 : ℕ) : ℝ) ^ 2 * log 2 + 2 := by have h := virtual_core_log_loss_bound hx hxJ N have hl := log_one_add_le_dyadic hx hxJ have hm := mul_le_mul_of_nonneg_left hl (Nat.cast_nonneg J) have hlog : 0 ≤ log (2 : ℝ) := log_nonneg (by norm_num) have hj : (0 : ℝ) ≤ J := Nat.cast_nonneg J push_cast at hm ⊢ nlinarith theorem core_suffix_shift_loss_sum_le {A B : ℝ} (hA : 0 ≤ A) (hB : 0 < B) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) (r n K : ℕ) : (∑ b ∈ range r, ∑ j ∈ range K, log (1 + (A / B) / (2 : ℝ) ^ (b * (n + K) + n + j))) ≤ ((J + 1 : ℕ) : ℝ) ^ 2 * log 2 + 2 := by have hnonneg (l : ℕ) : 0 ≤ log (1 + (A / B) / (2 : ℝ) ^ l) := by apply log_nonneg have : 0 ≤ (A / B) / (2 : ℝ) ^ l := by positivity linarith apply le_trans _ (core_log_shift_loss_sum_le (div_nonneg hA hB.le) hAB (r * (n + K))) rw [sum_range_blocks] apply sum_le_sum intro b _ rw [sum_range_add] simp only [Nat.add_assoc] exact le_add_of_nonneg_left (sum_nonneg (fun i _ ↦ hnonneg (b * (n + K) + i))) theorem core_suffix_shift_product_lower {A B : ℝ} (hA : 0 ≤ A) (hB : 0 < B) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) (r n K : ℕ) : exp (-(((J + 1 : ℕ) : ℝ) ^ 2 * log 2 + 2)) ≤ ∏ b ∈ range r, ∏ j ∈ range K, 1 / (1 + (A / B) / (2 : ℝ) ^ (b * (n + K) + n + j)) := by have hsum := core_suffix_shift_loss_sum_le hA hB hAB r n K calc _ ≤ exp (-(∑ b ∈ range r, ∑ j ∈ range K, log (1 + (A / B) / (2 : ℝ) ^ (b * (n + K) + n + j)))) := exp_le_exp.mpr (neg_le_neg hsum) _ = _ := by rw [← sum_neg_distrib, exp_sum] apply prod_congr rfl intro b _ rw [← sum_neg_distrib, exp_sum] apply prod_congr rfl intro j _ rw [exp_neg, exp_log (by positivity)] exact (one_div _).symm theorem coreMultiBlockEventMass_decreasing_head_lower {n : ℕ} (hn : 0 < n) (K r : ℕ) {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (heta : 0 < eta) (heta2 : eta ≤ log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ eta * B) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) : (∏ b : Fin r, max 0 (coreBlockPrefixLower A (B * 2 ^ (b.val * (n + K))) lam n (coreBlockHead J (n + K) b.val)) * coreBlockSuffixLower A (B * 2 ^ (b.val * (n + K))) eta lam n K) ≤ coreMultiBlockEventMass A B eta lam n K r := coreMultiBlockEventMass_explicit_lower hn K r hA hB hbase heta heta2 hlam hlam2 hlarge (fun b ↦ coreBlockHead J (n + K) b.val) (fun b ↦ coreBlockHead_admissible hB hAB (n + K) b.val) end Erdos859Verification end /- Inlined development module: FordCubeBarrier.lean -/ section /- The actual uniform-cube barrier law and the tails of the sorted deficit. -/ open MeasureTheory Set Real open scoped ENNReal namespace Erdos859Verification noncomputable def fordSortedTuple {k : ℕ} (x : Fin k → ℝ) : Fin k → ℝ := x ∘ Tuple.sort x theorem fordSortedTuple_eq_of_monotone {k : ℕ} (x : Fin k → ℝ) (σ : Equiv.Perm (Fin k)) (hσ : Monotone (x ∘ σ)) : fordSortedTuple x = x ∘ σ := Tuple.unique_monotone (Tuple.monotone_sort x) hσ theorem fordSortedTuple_measurable (k : ℕ) : Measurable (fordSortedTuple : (Fin k → ℝ) → (Fin k → ℝ)) := by intro S hS have heq : fordSortedTuple ⁻¹' S = ⋃ σ : Equiv.Perm (Fin k), {x | Monotone (x ∘ σ)} ∩ (fun x ↦ x ∘ σ) ⁻¹' S := by ext x constructor · intro hx exact mem_iUnion.mpr ⟨Tuple.sort x, Tuple.monotone_sort x, hx⟩ · intro hx obtain ⟨σ, hσ⟩ := mem_iUnion.mp hx change fordSortedTuple x ∈ S rw [fordSortedTuple_eq_of_monotone x σ hσ.1] exact hσ.2 rw [heq] exact MeasurableSet.iUnion fun σ ↦ (isClosed_monotone.measurableSet.preimage (ford_permute_measurePreserving σ).measurable).inter (hS.preimage (ford_permute_measurePreserving σ).measurable) def fordCubeBarrier (k : ℕ) (u v : ℝ) : Set (Fin k → ℝ) := Icc (fun _ ↦ 0) (fun _ ↦ 1) ∩ {x | fordSortedTuple x ∈ fordBarrier k u v} def fordCubeBarrierChamber {k : ℕ} (u v : ℝ) (σ : Equiv.Perm (Fin k)) : Set (Fin k → ℝ) := (fun x ↦ x ∘ σ) ⁻¹' fordBarrierGood k 1 u v theorem fordCubeBarrier_measurable (k : ℕ) (u v : ℝ) : MeasurableSet (fordCubeBarrier k u v) := measurableSet_Icc.inter ((fordBarrier_measurable k u v).preimage (fordSortedTuple_measurable k)) theorem fordCubeBarrierChamber_measurable {k : ℕ} (u v : ℝ) (σ : Equiv.Perm (Fin k)) : MeasurableSet (fordCubeBarrierChamber u v σ) := (fordBarrierGood_measurable k 1 u v).preimage (ford_permute_measurePreserving σ).measurable theorem fordCubeBarrierChamber_volume {k : ℕ} (u v : ℝ) (σ : Equiv.Perm (Fin k)) : volume (fordCubeBarrierChamber u v σ) = volume (fordBarrierGood k 1 u v) := (ford_permute_measurePreserving σ).measure_preimage (fordBarrierGood_measurable k 1 u v).nullMeasurableSet theorem fordCubeBarrierChamber_pairwise_aedisjoint (k : ℕ) (u v : ℝ) : Pairwise (fun σ τ : Equiv.Perm (Fin k) ↦ AEDisjoint volume (fordCubeBarrierChamber u v σ) (fordCubeBarrierChamber u v τ)) := by intro σ τ hστ exact (fordOrderedChamber_pairwise_aedisjoint k 1 hστ).mono (fun _ hx ↦ hx.1) (fun _ hx ↦ hx.1) theorem fordCubeBarrierChamber_iUnion (k : ℕ) (u v : ℝ) : (⋃ σ : Equiv.Perm (Fin k), fordCubeBarrierChamber u v σ) = fordCubeBarrier k u v := by ext x constructor · intro hx obtain ⟨σ, hσ⟩ := mem_iUnion.mp hx refine ⟨⟨?_, ?_⟩, ?_⟩ · intro i simpa only [Function.comp_apply, Equiv.apply_symm_apply] using hσ.1.1.1 (σ.symm i) · intro i simpa only [Function.comp_apply, Equiv.apply_symm_apply] using hσ.1.1.2 (σ.symm i) · change fordSortedTuple x ∈ fordBarrier k u v rw [fordSortedTuple_eq_of_monotone x σ hσ.1.2] exact hσ.2 · intro hx refine mem_iUnion.mpr ⟨Tuple.sort x, ⟨?_, Tuple.monotone_sort x⟩, hx.2⟩ exact ⟨fun i ↦ hx.1.1 _, fun i ↦ hx.1.2 _⟩ /-- The sorted cube event has exactly `k!` times its ordered-simplex volume. -/ theorem fordCubeBarrier_volume (k : ℕ) (u v : ℝ) : volume (fordCubeBarrier k u v) = (k.factorial : ℝ≥0∞) * volume (fordBarrierGood k 1 u v) := by rw [← fordCubeBarrierChamber_iUnion, measure_iUnion₀ (fordCubeBarrierChamber_pairwise_aedisjoint k u v) (fun σ ↦ (fordCubeBarrierChamber_measurable u v σ).nullMeasurableSet)] simp only [fordCubeBarrierChamber_volume, tsum_fintype, Finset.sum_const, Finset.card_univ, Fintype.card_perm, Fintype.card_fin, nsmul_eq_mul] theorem fordCubeBarrier_volume_toReal (k : ℕ) (u v : ℝ) : (volume (fordCubeBarrier k u v)).toReal = (k.factorial : ℝ) * (volume (fordBarrierGood k 1 u v)).toReal := by rw [fordCubeBarrier_volume, ENNReal.toReal_mul, ENNReal.toReal_natCast] /-- Since the unit cube has volume one, this is the actual uniform-cube probability bound. -/ theorem fordCubeBarrier_probability_bound {k : ℕ} (hk : 0 < k) {u v w : ℝ} (hu : 0 ≤ u) (hw : 0 ≤ w) (hrel : v = (k : ℝ) + w - u) : (volume (fordCubeBarrier k u v)).toReal ≤ 36 * (u + 1) * (w + 1) ^ 2 / k := by rw [fordCubeBarrier_volume_toReal] exact fordBarrier_bound hk hu hw hrel noncomputable def fordCubeDeficit {k : ℕ} (v : ℝ) (x : Fin k → ℝ) : ℝ := by classical exact (insert 0 (Finset.univ.image fun i : Fin k ↦ v * fordSortedTuple x i - ((i.val : ℝ) + 1))).min' (by simp) theorem le_fordCubeDeficit_iff {k : ℕ} (v a : ℝ) (x : Fin k → ℝ) : a ≤ fordCubeDeficit v x ↔ a ≤ 0 ∧ ∀ i, a ≤ v * fordSortedTuple x i - ((i.val : ℝ) + 1) := by classical unfold fordCubeDeficit rw [Finset.le_min'_iff] simp theorem fordCubeDeficit_nonpos {k : ℕ} (v : ℝ) (x : Fin k → ℝ) : fordCubeDeficit v x ≤ 0 := ((le_fordCubeDeficit_iff v (fordCubeDeficit v x) x).mp le_rfl).1 theorem fordCubeDeficit_le_coordinate {k : ℕ} (v : ℝ) (x : Fin k → ℝ) (i : Fin k) : fordCubeDeficit v x ≤ v * fordSortedTuple x i - ((i.val : ℝ) + 1) := ((le_fordCubeDeficit_iff v (fordCubeDeficit v x) x).mp le_rfl).2 i theorem fordCubeDeficit_measurable (k : ℕ) (v : ℝ) : Measurable (fordCubeDeficit v : (Fin k → ℝ) → ℝ) := by apply measurable_of_Ici intro a have heq : (fordCubeDeficit v : (Fin k → ℝ) → ℝ) ⁻¹' Ici a = {x | a ≤ 0} ∩ {x | ∀ i, a ≤ v * fordSortedTuple x i - ((i.val : ℝ) + 1)} := by ext x exact le_fordCubeDeficit_iff v a x rw [heq] apply (measurableSet_le measurable_const measurable_const).inter simp only [ofPred_forall] exact MeasurableSet.iInter fun i ↦ measurableSet_le measurable_const ((measurable_const.mul ((measurable_pi_apply i).comp (fordSortedTuple_measurable k))).sub measurable_const) theorem fordCubeDeficit_le_min {k : ℕ} (hk : 0 < k) {v : ℝ} (hv : 0 ≤ v) {x : Fin k → ℝ} (hx : x ∈ Icc (fun _ ↦ 0) (fun _ ↦ 1)) : fordCubeDeficit v x ≤ min 0 (v - k) := by apply le_min (fordCubeDeficit_nonpos v x) cases k with | zero => omega | succ k => have h := fordCubeDeficit_le_coordinate v x (Fin.last k) have htop : fordSortedTuple x (Fin.last k) ≤ 1 := hx.2 _ have hm := mul_le_mul_of_nonneg_left htop hv simp only [Fin.val_last, Nat.cast_add, Nat.cast_one] at h ⊢ linarith theorem fordCubeDeficit_tail_eq {k : ℕ} (v : ℝ) {s : ℝ} (hs : 0 ≤ s) : (Icc (fun _ : Fin k ↦ (0 : ℝ)) (fun _ ↦ 1) ∩ {x | -s ≤ fordCubeDeficit v x}) = fordCubeBarrier k s v := by ext x simp only [mem_inter_iff, mem_ofPred_eq, le_fordCubeDeficit_iff, fordCubeBarrier, fordBarrier] have hs' : -s ≤ 0 := by linarith simp only [hs', true_and] constructor · rintro ⟨hx, h⟩ exact ⟨hx, fun i ↦ by linarith [h i]⟩ · rintro ⟨hx, h⟩ exact ⟨hx, fun i ↦ by linarith [h i]⟩ /-- Tail bound at every nonnegative level where the Ford parameter `w` is nonnegative. -/ theorem fordCubeDeficit_tail_bound {k : ℕ} (hk : 0 < k) {v s : ℝ} (hs : 0 ≤ s) (hw : 0 ≤ s + v - k) : (volume (Icc (fun _ : Fin k ↦ (0 : ℝ)) (fun _ ↦ 1) ∩ {x | -s ≤ fordCubeDeficit v x})).toReal ≤ 36 * (s + 1) * (s + v - k + 1) ^ 2 / k := by rw [fordCubeDeficit_tail_eq v hs] exact fordCubeBarrier_probability_bound hk hs hw (by ring) theorem fordCubeDeficit_tail_empty {k : ℕ} (hk : 0 < k) {v s : ℝ} (hv : 0 ≤ v) (hs : s < (k : ℝ) - v) : (Icc (fun _ : Fin k ↦ (0 : ℝ)) (fun _ ↦ 1) ∩ {x | -s ≤ fordCubeDeficit v x}) = ∅ := by apply eq_empty_iff_forall_notMem.mpr intro x hx have h := (fordCubeDeficit_le_min hk hv hx.1).trans (min_le_right _ _) have ht : -s ≤ fordCubeDeficit v x := hx.2 linarith theorem ford_unitCube_volume (k : ℕ) : volume (Icc (fun _ : Fin k ↦ (0 : ℝ)) (fun _ ↦ 1)) = 1 := by rw [Real.volume_Icc_pi] simp end Erdos859Verification end /- Inlined development module: PrimePairDivisorSupport.lean -/ section /- Actual prime-pair difference cubes embed, after a fixed translation, in the logarithmic subset-sum and divisor supports of the selected primes. -/ namespace Erdos859Verification open Finset Real MeasureTheory def primePairLabel {ι : Type*} (p q : ι → ℕ) (z : ι × Bool) : ℕ := if z.2 then p z.1 else q z.1 /-- Labels from different coordinates are distinct. Reusing the same label within one pair is harmless because a bit chooses only one label per pair. -/ def PairCoordinateSeparated {ι : Type*} (p q : ι → ℕ) : Prop := ∀ x y : ι × Bool, primePairLabel p q x = primePairLabel p q y → x.1 = y.1 theorem pairCoordinateSeparated_of_injective {ι : Type*} {p q : ι → ℕ} (h : Function.Injective (primePairLabel p q)) : PairCoordinateSeparated p q := fun _ _ heq ↦ congrArg Prod.fst (h heq) def primePairLabels {ι : Type*} [Fintype ι] (p q : ι → ℕ) : Finset ℕ := univ.image p ∪ univ.image q def primePairChoice {ι : Type*} [Fintype ι] (p q : ι → ℕ) (b : ι → Bool) : Finset ℕ := univ.image (fun i ↦ primePairLabel p q (i, b i)) theorem primePairChoice_subset {ι : Type*} [Fintype ι] (p q : ι → ℕ) (b : ι → Bool) : primePairChoice p q b ⊆ primePairLabels p q := by intro r hr obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp hr cases hb : b i · exact Finset.mem_union_right _ (mem_image_of_mem q (mem_univ i)) · exact Finset.mem_union_left _ (mem_image_of_mem p (mem_univ i)) theorem primePairChoice_log_sum {ι : Type*} [Fintype ι] {p q : ι → ℕ} (hsep : PairCoordinateSeparated p q) (b : ι → Bool) : (∑ r ∈ primePairChoice p q b, log (r : ℝ)) = (∑ i, log (q i : ℝ)) + ∑ i, if b i then log (p i : ℝ) - log (q i : ℝ) else 0 := by rw [primePairChoice, sum_image (fun i _ j _ hij ↦ hsep (i, b i) (j, b j) hij)] calc _ = ∑ i, (log (q i : ℝ) + if b i then log (p i : ℝ) - log (q i : ℝ) else 0) := by apply sum_congr rfl intro i _ cases b i <;> simp [primePairLabel] _ = _ := sum_add_distrib /-- The `+e` translation compensates for the negative side of symmetric thickening, yielding the one-sided interval width `d + 2e`. -/ theorem prime_pair_thickened_support_subset {ι : Type*} [Fintype ι] {p q : ι → ℕ} {C : Finset ℕ} (hsep : PairCoordinateSeparated p q) (hcore : Disjoint C (primePairLabels p q)) (d e : ℝ) : realTranslateSet (finiteThickenedTranslateSupport (primeSubsetSumSupport C d) univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ)) e) ((∑ i, log (q i : ℝ)) + e) ⊆ primeSubsetSumSupport (C ∪ primePairLabels p q) (d + 2 * e) := by classical intro z hz change z - ((∑ i, log (q i : ℝ)) + e) ∈ finiteSubsetTranslateSupport (realSupportThickening (primeSubsetSumSupport C d) e) univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ)) at hz obtain ⟨J, _, a, ha, herror⟩ := mem_finiteSubsetTranslateSupport.mp hz let b : ι → Bool := fun i ↦ decide (i ∈ J) have hbits : (∑ i, if b i then log (p i : ℝ) - log (q i : ℝ) else 0) = ∑ i ∈ J, (log (p i : ℝ) - log (q i : ℝ)) := by simp only [b, decide_eq_true_eq] rw [← sum_filter] simp rw [← hbits] at herror obtain ⟨U, hUC, hUa⟩ := mem_primeSubsetSumSupport.mp ha have hV := primePairChoice_subset p q b have hdis : Disjoint U (primePairChoice p q b) := hcore.mono hUC hV refine mem_primeSubsetSumSupport.mpr ⟨U ∪ primePairChoice p q b, union_subset_union hUC hV, ?_⟩ rw [sum_union hdis, primePairChoice_log_sum hsep b] have he := abs_le.mp herror constructor <;> linarith [hUa.1, hUa.2, he.1, he.2] theorem prime_pair_subset_translate_support {ι : Type*} [Fintype ι] {p q : ι → ℕ} {C : Finset ℕ} (hsep : PairCoordinateSeparated p q) (hcore : Disjoint C (primePairLabels p q)) (d : ℝ) : realTranslateSet (finiteSubsetTranslateSupport (primeSubsetSumSupport C d) univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ))) (∑ i, log (q i : ℝ)) ⊆ primeSubsetSumSupport (C ∪ primePairLabels p q) d := by simpa only [finiteThickenedTranslateSupport, realSupportThickening_zero, add_zero, mul_zero] using prime_pair_thickened_support_subset hsep hcore d 0 theorem prime_pair_thickened_support_subset_of_injective {ι : Type*} [Fintype ι] {p q : ι → ℕ} {C : Finset ℕ} (hinj : Function.Injective (primePairLabel p q)) (hcore : Disjoint C (primePairLabels p q)) (d e : ℝ) : realTranslateSet (finiteThickenedTranslateSupport (primeSubsetSumSupport C d) univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ)) e) ((∑ i, log (q i : ℝ)) + e) ⊆ primeSubsetSumSupport (C ∪ primePairLabels p q) (d + 2 * e) := prime_pair_thickened_support_subset (pairCoordinateSeparated_of_injective hinj) hcore d e theorem prime_pair_thickened_support_subset_divisors {ι : Type*} [Fintype ι] {p q : ι → ℕ} {C : Finset ℕ} (hsep : PairCoordinateSeparated p q) (hcore : Disjoint C (primePairLabels p q)) (hprime : ∀ r ∈ C ∪ primePairLabels p q, r.Prime) (d e : ℝ) : realTranslateSet (finiteThickenedTranslateSupport (primeSubsetSumSupport C d) univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ)) e) ((∑ i, log (q i : ℝ)) + e) ⊆ divisorLogSupport (∏ r ∈ C ∪ primePairLabels p q, r) (d + 2 * e) := (prime_pair_thickened_support_subset hsep hcore d e).trans (primeSubsetSumSupport_subset_divisorLogSupport hprime _) theorem pairCoordinateSeparated_of_disjoint_sets {ι : Type*} {T : ι → Finset ℕ} {p q : ι → ℕ} (hdis : Pairwise (fun i j ↦ Disjoint (T i) (T j))) (hp : ∀ i, p i ∈ T i) (hq : ∀ i, q i ∈ T i) : PairCoordinateSeparated p q := by have hm (x : ι × Bool) : primePairLabel p q x ∈ T x.1 := by cases hx : x.2 <;> simp only [primePairLabel, hx, Bool.false_eq_true, if_false, if_true] · exact hq x.1 · exact hp x.1 intro x y heq by_contra hne exact Finset.disjoint_left.mp (hdis hne) (hm x) (heq ▸ hm y) theorem primePairLabels_subset_bandUnion {ι : Type*} [Fintype ι] {T : ι → Finset ℕ} {p q : ι → ℕ} (hp : ∀ i, p i ∈ T i) (hq : ∀ i, q i ∈ T i) : primePairLabels p q ⊆ primeBandUnion T := by intro r hr rcases Finset.mem_union.mp hr with hr | hr · obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp hr exact mem_biUnion.mpr ⟨i, mem_univ i, hp i⟩ · obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp hr exact mem_biUnion.mpr ⟨i, mem_univ i, hq i⟩ /-- This version applies directly to witnesses from disjoint selected bands; the two witnesses within an individual band may coincide. -/ theorem selected_pair_support_subset_divisors {ι : Type*} [Fintype ι] {T : ι → Finset ℕ} {p q : ι → ℕ} {C : Finset ℕ} (hdis : Pairwise (fun i j ↦ Disjoint (T i) (T j))) (hp : ∀ i, p i ∈ T i) (hq : ∀ i, q i ∈ T i) (hcore : Disjoint C (primeBandUnion T)) (hprime : ∀ r ∈ C ∪ primeBandUnion T, r.Prime) (d e : ℝ) : realTranslateSet (finiteThickenedTranslateSupport (primeSubsetSumSupport C d) univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ)) e) ((∑ i, log (q i : ℝ)) + e) ⊆ divisorLogSupport (∏ r ∈ C ∪ primeBandUnion T, r) (d + 2 * e) := by have hlabels := primePairLabels_subset_bandUnion hp hq exact ((prime_pair_thickened_support_subset (pairCoordinateSeparated_of_disjoint_sets hdis hp hq) (hcore.mono Set.Subset.rfl hlabels) d e).trans (primeSubsetSumSupport_mono (union_subset_union Set.Subset.rfl hlabels) _)).trans (primeSubsetSumSupport_subset_divisorLogSupport hprime _) theorem finiteThickenedTranslateSupport_mono_base {ι : Type*} {A B : Set ℝ} (hAB : A ⊆ B) (P : Finset ι) (x : ι → ℝ) (e : ℝ) : finiteThickenedTranslateSupport A P x e ⊆ finiteThickenedTranslateSupport B P x e := by intro z hz obtain ⟨J, hJ, a, ha, herr⟩ := mem_finiteThickenedTranslateSupport.mp hz exact mem_finiteThickenedTranslateSupport.mpr ⟨J, hJ, a, hAB ha, herr⟩ theorem selected_base_pair_support_subset_divisors {ι : Type*} [Fintype ι] {T : ι → Finset ℕ} {p q : ι → ℕ} {C : Finset ℕ} {B : Set ℝ} {d e : ℝ} (hB : B ⊆ primeSubsetSumSupport C d) (hdis : Pairwise (fun i j ↦ Disjoint (T i) (T j))) (hp : ∀ i, p i ∈ T i) (hq : ∀ i, q i ∈ T i) (hcore : Disjoint C (primeBandUnion T)) (hprime : ∀ r ∈ C ∪ primeBandUnion T, r.Prime) : realTranslateSet (finiteThickenedTranslateSupport B univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ)) e) ((∑ i, log (q i : ℝ)) + e) ⊆ divisorLogSupport (∏ r ∈ C ∪ primeBandUnion T, r) (d + 2 * e) := by intro z hz apply selected_pair_support_subset_divisors hdis hp hq hcore hprime d e exact finiteThickenedTranslateSupport_mono_base hB _ _ _ hz theorem volume_realTranslateSet {A : Set ℝ} (hA : MeasurableSet A) (t : ℝ) : volume (realTranslateSet A t) = volume A := by rw [realTranslateSet, ← Measure.map_apply (f := fun x : ℝ ↦ x - t) (by fun_prop) hA] simpa only [sub_eq_add_neg] using congrArg (fun mu : Measure ℝ ↦ mu A) (map_add_right_eq_self volume (-t)) theorem realTranslateSet_Icc (a b t : ℝ) : realTranslateSet (Set.Icc a b) t = Set.Icc (a + t) (b + t) := by ext z change (a ≤ z - t ∧ z - t ≤ b) ↔ (a + t ≤ z ∧ z ≤ b + t) constructor <;> rintro ⟨h1, h2⟩ <;> constructor <;> linarith theorem translated_missing_measure_le {A D I : Set ℝ} (hA : MeasurableSet A) (hI : MeasurableSet I) (hIfin : volume I ≠ ⊤) (t : ℝ) (hsub : realTranslateSet A t ⊆ D) : volume.real (realTranslateSet I t \ D) ≤ volume.real (I \ A) := by have hfin : volume (realTranslateSet (I \ A) t) ≠ ⊤ := by rw [volume_realTranslateSet (hI.diff hA)] exact measure_ne_top_of_subset Set.sdiff_subset hIfin calc _ ≤ volume.real (realTranslateSet (I \ A) t) := by apply measureReal_mono _ hfin intro z hz exact ⟨hz.1, fun ha ↦ hz.2 (hsub ha)⟩ _ = _ := congrArg ENNReal.toReal (volume_realTranslateSet (hI.diff hA) t) theorem selected_pair_divisor_missing_le {ι : Type*} [Fintype ι] {T : ι → Finset ℕ} {p q : ι → ℕ} {C : Finset ℕ} (hdis : Pairwise (fun i j ↦ Disjoint (T i) (T j))) (hp : ∀ i, p i ∈ T i) (hq : ∀ i, q i ∈ T i) (hcore : Disjoint C (primeBandUnion T)) (hprime : ∀ r ∈ C ∪ primeBandUnion T, r.Prime) (d e a b : ℝ) : volume.real (Set.Icc (a + ((∑ i, log (q i : ℝ)) + e)) (b + ((∑ i, log (q i : ℝ)) + e)) \ divisorLogSupport (∏ r ∈ C ∪ primeBandUnion T, r) (d + 2 * e)) ≤ volume.real (Set.Icc a b \ finiteThickenedTranslateSupport (primeSubsetSumSupport C d) univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ)) e) := by have h := translated_missing_measure_le (I := Set.Icc a b) (measurableSet_finiteThickenedTranslateSupport (isCompact_primeSubsetSumSupport C d) _ _ _) measurableSet_Icc isCompact_Icc.measure_ne_top ((∑ i, log (q i : ℝ)) + e) (selected_pair_support_subset_divisors hdis hp hq hcore hprime d e) simpa only [realTranslateSet_Icc] using h theorem selected_base_pair_divisor_missing_le {ι : Type*} [Fintype ι] {T : ι → Finset ℕ} {p q : ι → ℕ} {C : Finset ℕ} {B : Set ℝ} {d e : ℝ} (hB : IsCompact B) (hBC : B ⊆ primeSubsetSumSupport C d) (hdis : Pairwise (fun i j ↦ Disjoint (T i) (T j))) (hp : ∀ i, p i ∈ T i) (hq : ∀ i, q i ∈ T i) (hcore : Disjoint C (primeBandUnion T)) (hprime : ∀ r ∈ C ∪ primeBandUnion T, r.Prime) (a b : ℝ) : volume.real (Set.Icc (a + ((∑ i, log (q i : ℝ)) + e)) (b + ((∑ i, log (q i : ℝ)) + e)) \ divisorLogSupport (∏ r ∈ C ∪ primeBandUnion T, r) (d + 2 * e)) ≤ volume.real (Set.Icc a b \ finiteThickenedTranslateSupport B univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ)) e) := by have h := translated_missing_measure_le (I := Set.Icc a b) (measurableSet_finiteThickenedTranslateSupport hB _ _ _) measurableSet_Icc isCompact_Icc.measure_ne_top ((∑ i, log (q i : ℝ)) + e) (selected_base_pair_support_subset_divisors hBC hdis hp hq hcore hprime) simpa only [realTranslateSet_Icc] using h end Erdos859Verification end /- Inlined development module: FordPrimeCoordinates.lean -/ section /- Cumulative reciprocal-odds coordinates control the logarithm of a prime. -/ open Finset Real namespace Erdos859Verification noncomputable def fordPrimeCumulativeOdds (N : ℕ) : ℝ := ∑ q ∈ (Ioc 0 N).filter Nat.Prime, fordPrimeOdds q theorem fordPrimeCumulativeOdds_nonneg (N : ℕ) : 0 ≤ fordPrimeCumulativeOdds N := sum_nonneg fun q _ ↦ fordPrimeOdds_nonneg q theorem fordPrimeCumulativeOdds_mono : Monotone fordPrimeCumulativeOdds := by intro N M hNM apply sum_le_sum_of_subset_of_nonneg · intro q hq exact mem_filter.mpr ⟨mem_Ioc.mpr ⟨(mem_Ioc.mp (mem_filter.mp hq).1).1, (mem_Ioc.mp (mem_filter.mp hq).1).2.trans hNM⟩, (mem_filter.mp hq).2⟩ · intro q _ _ exact fordPrimeOdds_nonneg q theorem ford_prime_prefix_insert {p : ℕ} (hp : p.Prime) : (Ioc 0 p).filter Nat.Prime = insert p ((Ioc 0 (p - 1)).filter Nat.Prime) := by ext q simp only [mem_filter, mem_Ioc, mem_insert] constructor · rintro ⟨⟨hq0, hqp⟩, hq⟩ by_cases heq : q = p · exact Or.inl heq · exact Or.inr ⟨⟨hq0, by omega⟩, hq⟩ · rintro (rfl | ⟨⟨hq0, hqp⟩, hq⟩) · exact ⟨⟨hp.pos, le_rfl⟩, hp⟩ · exact ⟨⟨hq0, by omega⟩, hq⟩ theorem ford_prime_notMem_prefix {p : ℕ} (hp : p.Prime) : p ∉ (Ioc 0 (p - 1)).filter Nat.Prime := by intro h have := (mem_Ioc.mp (mem_filter.mp h).1).2 have := hp.pos omega theorem fordPrimeCumulativeOdds_jump {p : ℕ} (hp : p.Prime) : fordPrimeCumulativeOdds p = fordPrimeCumulativeOdds (p - 1) + fordPrimeOdds p := by unfold fordPrimeCumulativeOdds rw [ford_prime_prefix_insert hp, sum_insert (ford_prime_notMem_prefix hp)] ring theorem primeReciprocalSum_le_fordPrefix {p : ℕ} (hp : p.Prime) : primeReciprocalSum (p : ℝ) ≤ fordPrimeCumulativeOdds (p - 1) + 1 := by unfold primeReciprocalSum rw [Nat.floor_natCast, ford_prime_prefix_insert hp, sum_insert (ford_prime_notMem_prefix hp)] have hterm : ∀ q ∈ (Ioc 0 (p - 1)).filter Nat.Prime, 1 / (q : ℝ) ≤ fordPrimeOdds q := by intro q hq have hprime := (mem_filter.mp hq).2 have hq2 : (2 : ℝ) ≤ q := by exact_mod_cast hprime.two_le rw [fordPrimeOdds_eq hprime] exact one_div_le_one_div_of_le (by linarith) (by linarith) have hsum := sum_le_sum hterm have hp1 : (1 : ℝ) ≤ p := by exact_mod_cast hp.one_le have hrec : 1 / (p : ℝ) ≤ 1 := (div_le_one (by linarith : (0 : ℝ) < p)).mpr hp1 change _ ≤ (∑ q ∈ (Ioc 0 (p - 1)).filter Nat.Prime, fordPrimeOdds q) + 1 linarith noncomputable def fordPrimeCoordinateConstant : ℝ := exp (-PrimeMertens.M + mertensErrorConstant / log 2 + 1) theorem fordPrimeCoordinateConstant_pos : 0 < fordPrimeCoordinateConstant := exp_pos _ theorem ford_prime_log_le_coordinate {p : ℕ} (hp : p.Prime) {u : ℝ} (hu : fordPrimeCumulativeOdds (p - 1) ≤ u) : log (p : ℝ) ≤ fordPrimeCoordinateConstant * exp u := by have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le have hl2 : 0 < log (2 : ℝ) := log_pos (by norm_num) have hlp : 0 < log (p : ℝ) := log_pos (by exact_mod_cast hp.one_lt) have hlog := log_le_log (by norm_num : (0 : ℝ) < 2) hp2 have herr := div_le_div_of_nonneg_left mertensErrorConstant_pos.le hl2 hlog have hrec := (abs_le.mp (primeReciprocalSum_estimate hp2)).1 have hprefix := primeReciprocalSum_le_fordPrefix hp have hbound : log (log (p : ℝ)) ≤ u - PrimeMertens.M + mertensErrorConstant / log 2 + 1 := by linarith calc _ = exp (log (log (p : ℝ))) := (exp_log hlp).symm _ ≤ exp (u - PrimeMertens.M + mertensErrorConstant / log 2 + 1) := exp_le_exp.mpr hbound _ = _ := by unfold fordPrimeCoordinateConstant rw [← exp_add] congr 1 ring end Erdos859Verification end /- Inlined development module: FordPrimeRectangles.lean -/ section /- Disjoint coordinate intervals and exact reciprocal-odds rectangle volumes. -/ open Finset Real MeasureTheory open scoped ENNReal namespace Erdos859Verification def fordPrimeCoordinateCell (p : ℕ) : Set ℝ := Set.Ioc (fordPrimeCumulativeOdds (p - 1)) (fordPrimeCumulativeOdds p) theorem fordPrimeCoordinateCell_measurable (p : ℕ) : MeasurableSet (fordPrimeCoordinateCell p) := measurableSet_Ioc theorem fordPrimeCoordinateCell_volume {p : ℕ} (hp : p.Prime) : volume (fordPrimeCoordinateCell p) = ENNReal.ofReal (fordPrimeOdds p) := by rw [fordPrimeCoordinateCell, Real.volume_Ioc, fordPrimeCumulativeOdds_jump hp] simp only [add_sub_cancel_left] theorem fordPrimeCoordinateCell_disjoint {p q : ℕ} (hpq : p ≠ q) : Disjoint (fordPrimeCoordinateCell p) (fordPrimeCoordinateCell q) := by suffices h : ∀ a b : ℕ, a < b → Disjoint (fordPrimeCoordinateCell a) (fordPrimeCoordinateCell b) by rcases lt_or_gt_of_ne hpq with hlt | hlt · exact h p q hlt · exact (h q p hlt).symm intro a b hab apply Set.disjoint_left.mpr intro u hu hv have hcum := fordPrimeCumulativeOdds_mono (show a ≤ b - 1 by omega) exact (not_lt_of_ge (hu.2.trans hcum)) hv.1 theorem fordPrimeCoordinateCell_subset {p N : ℕ} (hpN : p ≤ N) : fordPrimeCoordinateCell p ⊆ Set.Icc 0 (fordPrimeCumulativeOdds N) := by intro u hu exact ⟨(fordPrimeCumulativeOdds_nonneg (p - 1)).trans hu.1.le, hu.2.trans (fordPrimeCumulativeOdds_mono hpN)⟩ theorem fordPrimeCoordinateCell_log_bound {p : ℕ} (hp : p.Prime) {u : ℝ} (hu : u ∈ fordPrimeCoordinateCell p) : log (p : ℝ) ≤ fordPrimeCoordinateConstant * exp u := ford_prime_log_le_coordinate hp hu.1.le def fordPrimeRectangle {ι : Type*} (p : ι → ℕ) : Set (ι → ℝ) := Set.univ.pi (fun i ↦ fordPrimeCoordinateCell (p i)) theorem mem_fordPrimeRectangle {ι : Type*} {p : ι → ℕ} {u : ι → ℝ} : u ∈ fordPrimeRectangle p ↔ ∀ i, u i ∈ fordPrimeCoordinateCell (p i) := by simp only [fordPrimeRectangle, Set.mem_pi, Set.mem_univ, forall_true_left] theorem fordPrimeRectangle_measurable {ι : Type*} [Fintype ι] (p : ι → ℕ) : MeasurableSet (fordPrimeRectangle p) := MeasurableSet.pi (Set.to_countable _) (fun i _ ↦ fordPrimeCoordinateCell_measurable (p i)) theorem fordPrimeRectangle_volume {ι : Type*} [Fintype ι] (p : ι → ℕ) (hp : ∀ i, (p i).Prime) : volume (fordPrimeRectangle p) = ∏ i, ENNReal.ofReal (fordPrimeOdds (p i)) := by rw [fordPrimeRectangle, volume_pi_pi] exact prod_congr rfl (fun i _ ↦ fordPrimeCoordinateCell_volume (hp i)) theorem fordPrimeRectangle_volume_real {ι : Type*} [Fintype ι] (p : ι → ℕ) (hp : ∀ i, (p i).Prime) : volume.real (fordPrimeRectangle p) = ∏ i, fordPrimeOdds (p i) := by rw [Measure.real, fordPrimeRectangle_volume p hp, ENNReal.toReal_prod] exact prod_congr rfl (fun i _ ↦ ENNReal.toReal_ofReal (fordPrimeOdds_nonneg (p i))) theorem fordPrimeRectangle_disjoint {ι : Type*} {p q : ι → ℕ} (hpq : p ≠ q) : Disjoint (fordPrimeRectangle p) (fordPrimeRectangle q) := by apply Set.disjoint_left.mpr intro u hp hq apply hpq funext i by_contra hne exact Set.disjoint_left.mp (fordPrimeCoordinateCell_disjoint hne) (mem_fordPrimeRectangle.mp hp i) (mem_fordPrimeRectangle.mp hq i) theorem fordPrimeRectangle_subset_cube {ι : Type*} {p : ι → ℕ} {N : ℕ} (hpN : ∀ i, p i ≤ N) : fordPrimeRectangle p ⊆ Set.Icc (fun _ ↦ 0) (fun _ ↦ fordPrimeCumulativeOdds N) := by intro u hu have h := fun i ↦ fordPrimeCoordinateCell_subset (hpN i) (mem_fordPrimeRectangle.mp hu i) exact ⟨fun i ↦ (h i).1, fun i ↦ (h i).2⟩ theorem fordPrimeRectangle_log_bounds {ι : Type*} {p : ι → ℕ} (hp : ∀ i, (p i).Prime) {u : ι → ℝ} (hu : u ∈ fordPrimeRectangle p) : ∀ i, log (p i : ℝ) ≤ fordPrimeCoordinateConstant * exp (u i) := fun i ↦ fordPrimeCoordinateCell_log_bound (hp i) (mem_fordPrimeRectangle.mp hu i) end Erdos859Verification end /- Inlined development module: FordPrimeRectangleIntegral.lean -/ section /- Exact reciprocal-odds cells turn finite prime sums into cube integrals. -/ open Finset MeasureTheory open scoped ENNReal namespace Erdos859Verification /-- No normalization of the prime weights is needed. Repeated-prime tuples also have disjoint cells, and can later be discarded by nonnegativity. -/ theorem ford_prime_tuple_rectangle_lintegral {P : Finset ℕ} {N n : ℕ} (hP : ∀ p ∈ P, p.Prime) (hPN : ∀ p ∈ P, p ≤ N) (F : (Fin n → P) → ℝ≥0∞) (G : (Fin n → ℝ) → ℝ≥0∞) (hFG : ∀ x u, u ∈ fordPrimeRectangle (fun i ↦ (x i).val) → F x ≤ G u) : (∑ x : Fin n → P, (∏ i, ENNReal.ofReal (fordPrimeOdds (x i).val)) * F x) ≤ ∫⁻ u in Set.Icc (fun _ : Fin n ↦ 0) (fun _ ↦ fordPrimeCumulativeOdds N), G u := by classical let R : (Fin n → P) → Set (Fin n → ℝ) := fun x ↦ fordPrimeRectangle (fun i ↦ (x i).val) have hR (x : Fin n → P) : MeasurableSet (R x) := fordPrimeRectangle_measurable _ have hdis : Pairwise (fun x y : Fin n → P ↦ Disjoint (R x) (R y)) := by intro x y hxy apply fordPrimeRectangle_disjoint intro heq apply hxy funext i exact Subtype.ext (congrFun heq i) have hsub : (⋃ x : Fin n → P, R x) ⊆ Set.Icc (fun _ : Fin n ↦ 0) (fun _ ↦ fordPrimeCumulativeOdds N) := Set.iUnion_subset (fun x ↦ fordPrimeRectangle_subset_cube (fun i ↦ hPN _ (x i).property)) calc _ = ∑ x : Fin n → P, ∫⁻ u in R x, F x := by apply sum_congr rfl intro x _ rw [lintegral_const, Measure.restrict_apply_univ] change _ = F x * volume (fordPrimeRectangle (fun i ↦ (x i).val)) rw [fordPrimeRectangle_volume _ (fun i ↦ hP _ (x i).property), mul_comm] _ ≤ ∑ x : Fin n → P, ∫⁻ u in R x, G u := sum_le_sum (fun x _ ↦ setLIntegral_mono' (hR x) (hFG x)) _ = ∫⁻ u in ⋃ x : Fin n → P, R x, G u := by rw [lintegral_iUnion hR hdis G, tsum_fintype] _ ≤ _ := lintegral_mono_set hsub end Erdos859Verification end /- Inlined development module: FordSubsetEnvelope.lean -/ section /- A continuous subset envelope controls the actual weighted prime support sum. -/ open Finset Real MeasureTheory open scoped ENNReal namespace Erdos859Verification noncomputable def fordSubsetEnvelope {n : ℕ} (u : Fin n → ℝ) : ℝ := (univ : Finset (Finset (Fin n))).inf' univ_nonempty (fun I ↦ (1 + ∑ i ∈ I, exp (u i)) / (2 : ℝ) ^ I.card) theorem fordSubsetEnvelope_nonneg {n : ℕ} (u : Fin n → ℝ) : 0 ≤ fordSubsetEnvelope u := by apply (le_inf'_iff _ _).mpr intro I _ positivity theorem fordSubsetEnvelope_le {n : ℕ} (u : Fin n → ℝ) (I : Finset (Fin n)) : fordSubsetEnvelope u ≤ (1 + ∑ i ∈ I, exp (u i)) / (2 : ℝ) ^ I.card := inf'_le _ (mem_univ I) theorem fordSubsetEnvelope_le_one {n : ℕ} (u : Fin n → ℝ) : fordSubsetEnvelope u ≤ 1 := by simpa using fordSubsetEnvelope_le u ∅ theorem fordSubsetEnvelope_continuous (n : ℕ) : Continuous (fordSubsetEnvelope : (Fin n → ℝ) → ℝ) := by apply Continuous.finset_inf'_apply intro I _ fun_prop theorem primeSupport_le_ford_subset_cost {P : Finset ℕ} {n : ℕ} (x : Fin n → P) (hx : Function.Injective x) {u : Fin n → ℝ} (hxu : ∀ i, log ((x i).val : ℝ) ≤ fordPrimeCoordinateConstant * exp (u i)) {d : ℝ} (hd : 0 ≤ d) (I : Finset (Fin n)) : volume.real (primeSubsetSumSupport (tupleSupport x) d) ≤ (d + fordPrimeCoordinateConstant) * (2 : ℝ) ^ n * ((1 + ∑ i ∈ I, exp (u i)) / (2 : ℝ) ^ I.card) := by have hinj : Function.Injective (fun i ↦ (x i).val) := fun i j hij ↦ hx (Subtype.ext hij) have hsub : I.image (fun i ↦ (x i).val) ⊆ tupleSupport x := image_subset_image (subset_univ I) have hcard : I.card ≤ n := by simpa using card_le_card (subset_univ I) have hsum : (∑ p ∈ I.image (fun i ↦ (x i).val), log (p : ℝ)) ≤ fordPrimeCoordinateConstant * ∑ i ∈ I, exp (u i) := by rw [sum_image (fun i _ j _ hij ↦ hinj hij), mul_sum] exact sum_le_sum fun i _ ↦ hxu i have hcore := primeSubsetSumSupport_measure_le_core hsub hd rw [card_tupleSupport x hx, card_image_of_injective _ hinj] at hcore have hE : 0 ≤ ∑ i ∈ I, exp (u i) := sum_nonneg fun _ _ ↦ (exp_pos _).le have hnum : (∑ p ∈ I.image (fun i ↦ (x i).val), log (p : ℝ)) + d ≤ (d + fordPrimeCoordinateConstant) * (1 + ∑ i ∈ I, exp (u i)) := by have hC := fordPrimeCoordinateConstant_pos nlinarith [mul_nonneg hd hE] calc _ ≤ _ := hcore _ ≤ (2 : ℝ) ^ (n - I.card) * ((d + fordPrimeCoordinateConstant) * (1 + ∑ i ∈ I, exp (u i))) := mul_le_mul_of_nonneg_left hnum (by positivity) _ = _ := by rw [pow_sub₀ _ (by norm_num : (2 : ℝ) ≠ 0) hcard]; ring theorem primeSupport_le_ford_subset_envelope {P : Finset ℕ} {n : ℕ} (x : Fin n → P) (hx : Function.Injective x) {u : Fin n → ℝ} (hxu : ∀ i, log ((x i).val : ℝ) ≤ fordPrimeCoordinateConstant * exp (u i)) {d : ℝ} (hd : 0 ≤ d) : volume.real (primeSubsetSumSupport (tupleSupport x) d) ≤ (d + fordPrimeCoordinateConstant) * (2 : ℝ) ^ n * fordSubsetEnvelope u := by obtain ⟨I, _, hI⟩ := (univ : Finset (Finset (Fin n))).exists_mem_eq_inf' univ_nonempty (fun I ↦ (1 + ∑ i ∈ I, exp (u i)) / (2 : ℝ) ^ I.card) change _ ≤ _ * (univ : Finset (Finset (Fin n))).inf' univ_nonempty _ rw [hI] exact primeSupport_le_ford_subset_cost x hx hxu hd I theorem ford_prime_support_tuple_integral {P : Finset ℕ} {N n : ℕ} (hP : ∀ p ∈ P, p.Prime) (hPN : ∀ p ∈ P, p ≤ N) {d : ℝ} (hd : 0 ≤ d) : (∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, ENNReal.ofReal (fordPrimeOdds (x i).val)) * ENNReal.ofReal (volume.real (primeSubsetSumSupport (tupleSupport x) d))) ≤ ∫⁻ u in Set.Icc (fun _ : Fin n ↦ 0) (fun _ ↦ fordPrimeCumulativeOdds N), ENNReal.ofReal ((d + fordPrimeCoordinateConstant) * (2 : ℝ) ^ n * fordSubsetEnvelope u) := by classical have h := ford_prime_tuple_rectangle_lintegral hP hPN (fun x : Fin n → P ↦ if Function.Injective x then ENNReal.ofReal (volume.real (primeSubsetSumSupport (tupleSupport x) d)) else 0) (fun u ↦ ENNReal.ofReal ((d + fordPrimeCoordinateConstant) * (2 : ℝ) ^ n * fordSubsetEnvelope u)) (by intro x u hu by_cases hx : Function.Injective x · rw [if_pos hx] exact ENNReal.ofReal_le_ofReal (primeSupport_le_ford_subset_envelope x hx (fordPrimeRectangle_log_bounds (fun i ↦ hP _ (x i).property) hu) hd) · rw [if_neg hx] exact zero_le) simpa only [mul_ite, mul_zero, ← sum_filter] using h end Erdos859Verification end /- Inlined development module: CoreBlockExponentialCost.lean -/ section /- Explicit exponential cost for actual blocks, conditional only on a numerical duplicate bound. -/ namespace Erdos859Verification open Finset Real noncomputable def corePrefixRate (lam : ℝ) : ℝ := lam * log 2 - 1 - log (lam * log 2) noncomputable def coreSuffixRate (eta lam : ℝ) : ℝ := lam * log 2 - log (lam * eta / 2) noncomputable def coreBlockPrefixCorrection (A B lam : ℝ) (n J : ℕ) : ℝ := 2 * lam * primeLogOddsErrorConstant / (A + B) + J * log (1 + A / B) + 2 + 2 * n * virtualPrimeRelativeError B noncomputable def coreBlockPrefixMain (A B lam : ℝ) (n J : ℕ) : ℝ := exp (-(n : ℝ) * (lam * log 2 - 1 - log (lam * log 2)) - 2 * lam * primeLogOddsErrorConstant / (A + B) - J * log (1 + A / B) - 2 - 2 * n * virtualPrimeRelativeError B) / (exp 1 * (n : ℝ) ^ 2) noncomputable def coreBlockDuplicateError (A B : ℝ) (n : ℕ) : ℝ := (8 * (n : ℝ) ^ 2 * (A + B) / (B * log 2)) * exp (-(A + B)) theorem coreBlockPrefixLower_eq_main_sub_error (A B lam : ℝ) (n J : ℕ) : coreBlockPrefixLower A B lam n J = coreBlockPrefixMain A B lam n J - coreBlockDuplicateError A B n := rfl theorem coreBlockPrefixHalfMain_eq_exp {n : ℕ} (hn : 0 < n) (A B lam : ℝ) (J : ℕ) : coreBlockPrefixMain A B lam n J / 2 = exp (-((n : ℝ) * corePrefixRate lam + coreBlockPrefixCorrection A B lam n J + (1 + log 2 + 2 * log (n : ℝ)))) := by have hnR : (0 : ℝ) < n := by exact_mod_cast hn have he : exp (1 + log 2 + 2 * log (n : ℝ)) = exp 1 * 2 * (n : ℝ) ^ 2 := by rw [exp_add, exp_add, show (2 : ℝ) * log (n : ℝ) = log (n : ℝ) + log (n : ℝ) by ring, exp_add, exp_log hnR, exp_log (by norm_num : (0 : ℝ) < 2)] ring have harg : -((n : ℝ) * corePrefixRate lam + coreBlockPrefixCorrection A B lam n J + (1 + log 2 + 2 * log (n : ℝ))) = (-(n : ℝ) * (lam * log 2 - 1 - log (lam * log 2)) - 2 * lam * primeLogOddsErrorConstant / (A + B) - J * log (1 + A / B) - 2 - 2 * n * virtualPrimeRelativeError B) - (1 + log 2 + 2 * log (n : ℝ)) := by unfold corePrefixRate coreBlockPrefixCorrection ring rw [harg, exp_sub, he, coreBlockPrefixMain] ring noncomputable def coreSuffixMarkCost (A B eta lam : ℝ) (l : ℕ) : ℝ := coreSuffixRate eta lam + 2 * lam * primeLogOddsErrorConstant / (A + B * 2 ^ l) + log (1 + (A / B) / (2 : ℝ) ^ l) theorem coreSuffixFactor_eq_exp {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (heta : 0 < eta) (hlam : 0 < lam) (l : ℕ) : exp (-(lam * (log 2 + 2 * primeLogOddsErrorConstant / (A + B * 2 ^ l)))) * (lam * eta * B * 2 ^ l / (2 * (A + B * 2 ^ l))) = exp (-coreSuffixMarkCost A B eta lam l) := by have hd : 0 < 1 + (A / B) / (2 : ℝ) ^ l := by positivity have ha : 0 < lam * eta / 2 := by positivity have hr : lam * eta * B * 2 ^ l / (2 * (A + B * 2 ^ l)) = (lam * eta / 2) / (1 + (A / B) / (2 : ℝ) ^ l) := by field_simp; ring calc _ = exp (-(lam * (log 2 + 2 * primeLogOddsErrorConstant / (A + B * 2 ^ l)))) * exp (log (lam * eta / 2) - log (1 + (A / B) / (2 : ℝ) ^ l)) := by rw [exp_sub, exp_log ha, exp_log hd, hr] _ = _ := by rw [← exp_add]; congr 1; unfold coreSuffixMarkCost coreSuffixRate; ring theorem coreBlockSuffixLower_eq_exp {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (heta : 0 < eta) (hlam : 0 < lam) (n K : ℕ) : coreBlockSuffixLower A B eta lam n K = exp (-(∑ j ∈ range K, coreSuffixMarkCost A B eta lam (n + j))) := by unfold coreBlockSuffixLower simp_rw [coreSuffixFactor_eq_exp hA hB heta hlam] rw [← exp_sum, ← sum_neg_distrib, Fin.sum_univ_eq_sum_range (fun j : ℕ ↦ -coreSuffixMarkCost A B eta lam (n + j))] theorem coreSuffixMarkCost_shift (A B eta lam : ℝ) (s l : ℕ) : coreSuffixMarkCost A (B * (2 : ℝ) ^ s) eta lam l = coreSuffixMarkCost A B eta lam (s + l) := by simp only [coreSuffixMarkCost, pow_add, mul_assoc, div_mul_eq_div_div] theorem coreBlockEventMass_half_main_lower {n : ℕ} (hn : 0 < n) (K : ℕ) {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (heta : 0 < eta) (heta2 : eta ≤ log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ eta * B) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) (hduplicate_half_main : coreBlockDuplicateError A B n ≤ coreBlockPrefixMain A B lam n J / 2) : (coreBlockPrefixMain A B lam n J / 2) * coreBlockSuffixLower A B eta lam n K ≤ coreBlockEventMass A B eta lam n K := by have hhalf : coreBlockPrefixMain A B lam n J / 2 ≤ coreBlockPrefixLower A B lam n J := by rw [coreBlockPrefixLower_eq_main_sub_error] linarith have hm := mul_le_mul_of_nonneg_right (hhalf.trans (le_max_right 0 _)) (coreBlockSuffixLower_nonneg hA hB heta.le (show (0 : ℝ) ≤ lam by linarith) n K) exact hm.trans (coreBlockEventMass_explicit_lower hn K hA hB hbase heta heta2 hlam hlam2 hlarge hAB) theorem core_suffix_reciprocal_sum_le {A B : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (r n K : ℕ) : (∑ b ∈ range r, ∑ j ∈ range K, 1 / (A + B * (2 : ℝ) ^ (b * (n + K) + n + j))) ≤ 2 / B := by have hfull : (∑ l ∈ range (r * (n + K)), 1 / (A + B * (2 : ℝ) ^ l)) ≤ 2 / B := by simpa only [Nat.mul_one] using coreBlock_reciprocal_error_sum_le hA hB (by norm_num : 0 < 1) (r * (n + K)) apply le_trans _ hfull rw [sum_range_blocks] apply sum_le_sum intro b _ rw [sum_range_add] simp only [Nat.add_assoc] exact le_add_of_nonneg_left (sum_nonneg (fun _ _ ↦ by positivity)) noncomputable def coreMultiBlockFiniteCost (A B eta lam : ℝ) (n K J b : ℕ) : ℝ := (n : ℝ) * corePrefixRate lam + coreBlockPrefixCorrection A (B * 2 ^ (b * (n + K))) lam n (coreBlockHead J (n + K) b) + (1 + log 2 + 2 * log (n : ℝ)) + ∑ j ∈ range K, coreSuffixMarkCost A B eta lam (b * (n + K) + n + j) noncomputable def coreMultiBlockCostUpper (_A B eta lam : ℝ) (n K r J : ℕ) : ℝ := (r : ℝ) * n * corePrefixRate lam + (r : ℝ) * K * coreSuffixRate eta lam + r * (3 + log 2 + 2 * log (n : ℝ)) + (min r (J / (n + K) + 1) : ℕ) * (J : ℝ) * (J + 1 : ℕ) * log 2 + ((J + 1 : ℕ) : ℝ) ^ 2 * log 2 + 2 + 8 * lam * primeLogOddsErrorConstant / B + 4 * n * virtualPrimeRelativeError B theorem core_suffix_cost_sum_le {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hlam : 0 ≤ lam) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) (r n K : ℕ) : (∑ b ∈ range r, ∑ j ∈ range K, coreSuffixMarkCost A B eta lam (b * (n + K) + n + j)) ≤ (r : ℝ) * K * coreSuffixRate eta lam + 4 * lam * primeLogOddsErrorConstant / B + ((J + 1 : ℕ) : ℝ) ^ 2 * log 2 + 2 := by have hrec : (∑ b ∈ range r, ∑ j ∈ range K, 2 * lam * primeLogOddsErrorConstant / (A + B * (2 : ℝ) ^ (b * (n + K) + n + j))) ≤ 4 * lam * primeLogOddsErrorConstant / B := by calc _ = (2 * lam * primeLogOddsErrorConstant) * ∑ b ∈ range r, ∑ j ∈ range K, 1 / (A + B * (2 : ℝ) ^ (b * (n + K) + n + j)) := by simp only [mul_sum] apply sum_congr rfl intro b _ apply sum_congr rfl intro j _ ring _ ≤ (2 * lam * primeLogOddsErrorConstant) * (2 / B) := mul_le_mul_of_nonneg_left (core_suffix_reciprocal_sum_le hA hB r n K) (by positivity [primeLogOddsErrorConstant_pos]) _ = _ := by ring have hshift := core_suffix_shift_loss_sum_le hA hB hAB r n K simp only [coreSuffixMarkCost, sum_add_distrib, sum_const, card_range, nsmul_eq_mul] linarith theorem coreMultiBlockFiniteCost_sum_le {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hlam : 0 ≤ lam) {n K J : ℕ} (hh : 0 < n + K) (hAB : A / B ≤ (2 : ℝ) ^ J) (r : ℕ) : (∑ b ∈ range r, coreMultiBlockFiniteCost A B eta lam n K J b) ≤ coreMultiBlockCostUpper A B eta lam n K r J := by have hp := coreBlock_prefix_correction_sum_le hA hB hlam hh hAB n r change (∑ b ∈ range r, coreBlockPrefixCorrection A (B * 2 ^ (b * (n + K))) lam n (coreBlockHead J (n + K) b)) ≤ _ at hp have hs := core_suffix_cost_sum_le (eta := eta) hA hB hlam hAB r n K simp only [coreMultiBlockFiniteCost, sum_add_distrib, sum_const, card_range, nsmul_eq_mul] unfold coreMultiBlockCostUpper convert add_le_add (le_refl ((r : ℝ) * n * corePrefixRate lam + r * (1 + log 2 + 2 * log (n : ℝ)))) (add_le_add hp hs) using 1 <;> first | rfl | ring theorem coreMultiBlockFiniteCost_exp_eq {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (heta : 0 < eta) (hlam : 0 < lam) {n : ℕ} (hn : 0 < n) (K J b : ℕ) : exp (-coreMultiBlockFiniteCost A B eta lam n K J b) = (coreBlockPrefixMain A (B * 2 ^ (b * (n + K))) lam n (coreBlockHead J (n + K) b) / 2) * coreBlockSuffixLower A (B * 2 ^ (b * (n + K))) eta lam n K := by rw [coreBlockPrefixHalfMain_eq_exp hn, coreBlockSuffixLower_eq_exp hA (by positivity) heta hlam, ← exp_add] congr 1 simp only [coreMultiBlockFiniteCost, coreSuffixMarkCost_shift, Nat.add_assoc] ring /-- The only per-block margin hypothesis is an explicit numerical comparison of the duplicate error with the analytic prefix main term. -/ theorem coreMultiBlockEventMass_finite_exponential_lower {n : ℕ} (hn : 0 < n) (K r : ℕ) {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (heta : 0 < eta) (heta2 : eta ≤ log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ eta * B) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) (hduplicate_half_main : ∀ b : Fin r, coreBlockDuplicateError A (B * 2 ^ (b.val * (n + K))) n ≤ coreBlockPrefixMain A (B * 2 ^ (b.val * (n + K))) lam n (coreBlockHead J (n + K) b.val) / 2) : exp (-(∑ b ∈ range r, coreMultiBlockFiniteCost A B eta lam n K J b)) ≤ coreMultiBlockEventMass A B eta lam n K r := by have hlampos : 0 < lam := by linarith have hprod := coreMultiBlockEventMass_lower_of_blocks (A := A) (eta := eta) (lam := lam) hB n K r (fun b ↦ exp (-coreMultiBlockFiniteCost A B eta lam n K J b.val)) (fun _ ↦ (exp_pos _).le) (fun b ↦ ?_) · convert hprod using 1 rw [← exp_sum, sum_neg_distrib, Fin.sum_univ_eq_sum_range (fun b : ℕ ↦ coreMultiBlockFiniteCost A B eta lam n K J b)] · rw [coreMultiBlockFiniteCost_exp_eq hA hB heta hlampos hn] have hp : (1 : ℝ) ≤ 2 ^ (b.val * (n + K)) := one_le_pow₀ (by norm_num) have hBB : B ≤ B * (2 : ℝ) ^ (b.val * (n + K)) := by simpa only [mul_one] using mul_le_mul_of_nonneg_left hp hB.le exact coreBlockEventMass_half_main_lower hn K hA (by positivity) (hbase.trans (add_le_add le_rfl hBB)) heta heta2 hlam hlam2 (hlarge.trans (mul_le_mul_of_nonneg_left hBB heta.le)) (coreBlockHead_admissible hB hAB (n + K) b.val) (hduplicate_half_main b) /-- Explicit finite exponential lower bound for the actual tilted-prime event. -/ theorem coreMultiBlockEventMass_exponential_lower {n : ℕ} (hn : 0 < n) (K r : ℕ) {A B eta lam : ℝ} (hA : 0 ≤ A) (hB : 0 < B) (hbase : log 2 ≤ A + B) (heta : 0 < eta) (heta2 : eta ≤ log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hlarge : 4 * primeLogOddsErrorConstant ≤ eta * B) {J : ℕ} (hAB : A / B ≤ (2 : ℝ) ^ J) (hduplicate_half_main : ∀ b : Fin r, coreBlockDuplicateError A (B * 2 ^ (b.val * (n + K))) n ≤ coreBlockPrefixMain A (B * 2 ^ (b.val * (n + K))) lam n (coreBlockHead J (n + K) b.val) / 2) : exp (-coreMultiBlockCostUpper A B eta lam n K r J) ≤ coreMultiBlockEventMass A B eta lam n K r := by apply le_trans (exp_le_exp.mpr (neg_le_neg (coreMultiBlockFiniteCost_sum_le hA hB (show (0 : ℝ) ≤ lam by linarith) (by omega) hAB r))) exact coreMultiBlockEventMass_finite_exponential_lower hn K r hA hB hbase heta heta2 hlam hlam2 hlarge hAB hduplicate_half_main end Erdos859Verification end /- Inlined development module: CoreBlockDuplicateMargin.lean -/ section /- Uniform numerical duplicate margins for all larger scales and shorter blocks. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification theorem corePrefixRate_nonneg {lam : ℝ} (hlam : 0 < lam) : 0 ≤ corePrefixRate lam := by have htheta : 0 < lam * log 2 := mul_pos hlam (log_pos (by norm_num)) have h := log_le_sub_one_of_pos htheta unfold corePrefixRate linarith theorem coreBlockPrefixMain_eq_correction (A B lam : ℝ) (n J : ℕ) : coreBlockPrefixMain A B lam n J = exp (-(n : ℝ) * corePrefixRate lam - coreBlockPrefixCorrection A B lam n J) / (exp 1 * (n : ℝ) ^ 2) := by unfold coreBlockPrefixMain corePrefixRate coreBlockPrefixCorrection congr 2 ring theorem coreBlockDuplicateError_comparison {A B₀ B : ℝ} (hA : 0 ≤ A) (hB₀ : 0 < B₀) (hBB : B₀ ≤ B) {n k : ℕ} (hnk : n ≤ k) : coreBlockDuplicateError A B n ≤ coreBlockDuplicateError A B₀ k := by have hB : 0 < B := hB₀.trans_le hBB have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hnR : (n : ℝ) ≤ k := by exact_mod_cast hnk have hs : (n : ℝ) ^ 2 ≤ (k : ℝ) ^ 2 := by gcongr have hquot := div_le_div_of_nonneg_left hA hB₀ hBB have hcoef : (8 * (n : ℝ) ^ 2 / log 2) * (1 + A / B) ≤ (8 * (k : ℝ) ^ 2 / log 2) * (1 + A / B₀) := mul_le_mul (div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_left hs (by norm_num)) hlog.le) (add_le_add le_rfl hquot) (by positivity) (by positivity) have hexp : exp (-(A + B)) ≤ exp (-(A + B₀)) := exp_le_exp.mpr (by linarith) calc _ = ((8 * (n : ℝ) ^ 2 / log 2) * (1 + A / B)) * exp (-(A + B)) := by unfold coreBlockDuplicateError field_simp ring _ ≤ ((8 * (k : ℝ) ^ 2 / log 2) * (1 + A / B₀)) * exp (-(A + B₀)) := mul_le_mul hcoef hexp (exp_pos _).le (by positivity) _ = _ := by unfold coreBlockDuplicateError field_simp ring theorem coreBlockPrefixCorrection_comparison {A B₀ B lam : ℝ} (hA : 0 ≤ A) (hB₀ : 0 < B₀) (hBB : B₀ ≤ B) (hlam : 0 ≤ lam) {n k J H : ℕ} (hnk : n ≤ k) (hJH : J ≤ H) : coreBlockPrefixCorrection A B lam n J ≤ coreBlockPrefixCorrection A B₀ lam k H := by have hB : 0 < B := hB₀.trans_le hBB have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hfirst := div_le_div_of_nonneg_left (show 0 ≤ 2 * lam * primeLogOddsErrorConstant by positivity [primeLogOddsErrorConstant_pos]) (show 0 < A + B₀ by positivity) (show A + B₀ ≤ A + B by linarith) have hquot := div_le_div_of_nonneg_left hA hB₀ hBB have hlogratio : log (1 + A / B) ≤ log (1 + A / B₀) := log_le_log (by positivity) (add_le_add le_rfl hquot) have hhead := mul_le_mul (show (J : ℝ) ≤ H by exact_mod_cast hJH) hlogratio (log_nonneg (le_add_of_nonneg_right (div_nonneg hA hB.le))) (Nat.cast_nonneg H) have hxi : virtualPrimeRelativeError B ≤ virtualPrimeRelativeError B₀ := by unfold virtualPrimeRelativeError exact div_le_div_of_nonneg_left (by positivity [primeLogOddsErrorConstant_pos]) (by positivity) (mul_le_mul_of_nonneg_right hBB hlog.le) have hxi0 : 0 ≤ virtualPrimeRelativeError B := by unfold virtualPrimeRelativeError positivity [primeLogOddsErrorConstant_pos] have hlast := mul_le_mul (mul_le_mul_of_nonneg_left (show (n : ℝ) ≤ k by exact_mod_cast hnk) (by norm_num : (0 : ℝ) ≤ 2)) hxi hxi0 (by positivity : 0 ≤ 2 * (k : ℝ)) unfold coreBlockPrefixCorrection exact add_le_add (add_le_add (add_le_add hfirst hhead) le_rfl) hlast theorem coreBlockPrefixMain_comparison {A B₀ B lam : ℝ} (hA : 0 ≤ A) (hB₀ : 0 < B₀) (hBB : B₀ ≤ B) (hlam : 0 < lam) {n k J H : ℕ} (hn : 0 < n) (hnk : n ≤ k) (hJH : J ≤ H) : coreBlockPrefixMain A B₀ lam k H ≤ coreBlockPrefixMain A B lam n J := by have hnR : (0 : ℝ) < n := by exact_mod_cast hn have hnkR : (n : ℝ) ≤ k := by exact_mod_cast hnk have hcost := coreBlockPrefixCorrection_comparison hA hB₀ hBB hlam.le hnk hJH have hrate := mul_le_mul_of_nonneg_right hnkR (corePrefixRate_nonneg hlam) have hexp : exp (-(k : ℝ) * corePrefixRate lam - coreBlockPrefixCorrection A B₀ lam k H) ≤ exp (-(n : ℝ) * corePrefixRate lam - coreBlockPrefixCorrection A B lam n J) := exp_le_exp.mpr (by linarith) have hden : exp 1 * (n : ℝ) ^ 2 ≤ exp 1 * (k : ℝ) ^ 2 := by gcongr rw [coreBlockPrefixMain_eq_correction, coreBlockPrefixMain_eq_correction] exact (div_le_div_of_nonneg_right hexp (by positivity)).trans (div_le_div_of_nonneg_left (exp_pos _).le (by positivity) hden) theorem coreBlockDuplicateError_le_global {k n : ℕ} {B : ℝ} (hBB : coreBallotScale k ≤ B) (hnk : n ≤ k) : coreBlockDuplicateError (coreBallotShift k) B n ≤ coreGlobalBallotDuplicateError k := coreBlockDuplicateError_comparison (coreBallotShift_nonneg k) (coreBallotScale_pos k) hBB hnk theorem coreGlobalBallotMain_le_block {lam : ℝ} (hlam : 0 < lam) {k n J : ℕ} {B : ℝ} (hBB : coreBallotScale k ≤ B) (hn : 0 < n) (hnk : n ≤ k) (hJ : J ≤ coreBallotHeadCount k) : coreGlobalBallotMain lam k ≤ coreBlockPrefixMain (coreBallotShift k) B lam n J := by have hmain : coreGlobalBallotMain lam k = coreBlockPrefixMain (coreBallotShift k) (coreBallotScale k) lam k (coreBallotHeadCount k) := by rw [coreBlockPrefixMain_eq_correction] rfl rw [hmain] exact coreBlockPrefixMain_comparison (coreBallotShift_nonneg k) (coreBallotScale_pos k) hBB hlam hn hnk hJ /-- One eventual bound controls every shorter prefix and every larger block scale. -/ theorem coreBlockDuplicateMargin_eventually_uniform {lam : ℝ} (hlam : 0 < lam) : ∀ᶠ k : ℕ in atTop, ∀ (B : ℝ) (n J : ℕ), coreBallotScale k ≤ B → 0 < n → n ≤ k → J ≤ coreBallotHeadCount k → coreBlockDuplicateError (coreBallotShift k) B n ≤ coreBlockPrefixMain (coreBallotShift k) B lam n J / 2 := by filter_upwards [coreGlobalBallot_duplicate_eventually_le_half_main lam] with k hk intro B n J hBB hn hnk hJ have hmain := coreGlobalBallotMain_le_block hlam hBB hn hnk hJ calc _ ≤ coreGlobalBallotDuplicateError k := coreBlockDuplicateError_le_global hBB hnk _ ≤ coreGlobalBallotMain lam k / 2 := by simpa only [one_div, one_mul, mul_comm, div_eq_mul_inv] using hk _ ≤ _ := div_le_div_of_nonneg_right hmain (by norm_num) /-- The actual multiblock exponential bound eventually has no duplicate-margin or analytic-error-size hypothesis. Length and head conditions are numerical. -/ theorem coreMultiBlockEventMass_eventually_exponential_lower {eta lam : ℝ} (heta : 0 < eta) (heta2 : eta ≤ log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) : ∀ᶠ k : ℕ in atTop, ∀ (B : ℝ) (n K r J : ℕ), coreBallotScale k ≤ B → 0 < n → n ≤ k → J ≤ coreBallotHeadCount k → coreBallotShift k / B ≤ (2 : ℝ) ^ J → exp (-coreMultiBlockCostUpper (coreBallotShift k) B eta lam n K r J) ≤ coreMultiBlockEventMass (coreBallotShift k) B eta lam n K r := by have hlarge : ∀ᶠ k : ℕ in atTop, 4 * primeLogOddsErrorConstant ≤ eta * coreBallotScale k := by filter_upwards [coreBallotScale_tendsto.eventually_ge_atTop (4 * primeLogOddsErrorConstant / eta)] with k hk simpa only [mul_comm] using (div_le_iff₀ heta).mp hk filter_upwards [coreBlockDuplicateMargin_eventually_uniform (show 0 < lam by linarith), hlarge] with k hmargin hlargek intro B n K r J hBB hn hnk hJ hAB have hB : 0 < B := (coreBallotScale_pos k).trans_le hBB apply coreMultiBlockEventMass_exponential_lower hn K r (coreBallotShift_nonneg k) hB ((coreBallot_base_large k).trans (add_le_add le_rfl hBB)) heta heta2 hlam hlam2 (hlargek.trans (mul_le_mul_of_nonneg_left hBB heta.le)) hAB intro b have hscale : coreBallotScale k ≤ B * (2 : ℝ) ^ (b.val * (n + K)) := by apply hBB.trans simpa only [mul_one] using mul_le_mul_of_nonneg_left (one_le_pow₀ (by norm_num : (1 : ℝ) ≤ 2) : (1 : ℝ) ≤ 2 ^ (b.val * (n + K))) hB.le exact hmargin _ _ _ hscale hn hnk ((Nat.sub_le J _).trans hJ) end Erdos859Verification end /- Inlined development module: FordDeficitMoment.lean -/ section /- An actual expectation bound for the exponential of the sorted cube deficit. -/ open MeasureTheory Set Real Filter open scoped ENNReal namespace Erdos859Verification theorem ford_cubic_choose_bound (j : ℕ) : ((j : ℝ) + 2) ^ 3 ≤ 12 * ((j + 3).choose 3 : ℝ) := by have h := Nat.descFactorial_eq_factorial_mul_choose (j + 3) 3 norm_num [Nat.descFactorial_succ, show j + 3 - 2 = j + 1 by omega, show j + 3 - 1 = j + 2 by omega] at h have hc : ((j : ℝ) + 1) * ((j : ℝ) + 2) * ((j : ℝ) + 3) = 6 * ((j + 3).choose 3 : ℝ) := by rw [mul_assoc] exact_mod_cast h nlinarith [Nat.cast_nonneg (α := ℝ) j, sq_nonneg (j : ℝ), pow_nonneg (Nat.cast_nonneg (α := ℝ) j) 3] theorem ford_geometric_cubic_sum_bound : (∑' j : ℕ, ENNReal.ofReal (((1 / 2 : ℝ) ^ j) * ((j : ℝ) + 2) ^ 3)) ≤ 192 := by have hs := hasSum_choose_mul_geometric_of_norm_lt_one (𝕜 := ℝ) 3 (by norm_num : ‖(1 / 2 : ℝ)‖ < 1) have hsum : (∑' j : ℕ, ((j + 3).choose 3 : ℝ) * (1 / 2 : ℝ) ^ j) = 16 := by calc _ = 1 / (1 - (1 / 2 : ℝ)) ^ (3 + 1) := hs.tsum_eq _ = 16 := by norm_num have he : (∑' j : ℕ, ENNReal.ofReal (((j + 3).choose 3 : ℝ) * (1 / 2 : ℝ) ^ j)) = 16 := by rw [← ENNReal.ofReal_tsum_of_nonneg (fun _ ↦ by positivity) hs.summable, hsum] norm_num calc _ ≤ ∑' j : ℕ, ENNReal.ofReal (12 * (((j + 3).choose 3 : ℝ) * (1 / 2 : ℝ) ^ j)) := by apply ENNReal.tsum_le_tsum intro j apply ENNReal.ofReal_le_ofReal have h := mul_le_mul_of_nonneg_left (ford_cubic_choose_bound j) (by positivity : (0 : ℝ) ≤ (1 / 2 : ℝ) ^ j) nlinarith _ = 192 := by simp_rw [ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 12)] rw [ENNReal.tsum_mul_left, he] norm_num noncomputable def fordDeficitWeight (r : ℝ) (j : ℕ) : ℝ := exp (-log 2 * r) * (1 / 2 : ℝ) ^ j theorem fordDeficitWeight_eq_exp (r : ℝ) (j : ℕ) : fordDeficitWeight r j = exp (-log 2 * (r + j)) := by have he : exp (-log (2 : ℝ)) = (1 / 2 : ℝ) := by rw [exp_neg, exp_log (by norm_num)] norm_num unfold fordDeficitWeight rw [show -log 2 * (r + (j : ℝ)) = -log 2 * r + (j : ℝ) * (-log 2) by ring, exp_add, exp_nat_mul, he] theorem fordDeficit_exp_le_layers {r y : ℝ} (hy : y ≤ -r) : ENNReal.ofReal (exp (log 2 * y)) ≤ ∑' j : ℕ, if -(r + j + 1) ≤ y then ENNReal.ofReal (fordDeficitWeight r j) else 0 := by classical let j : ℕ := ⌊-y - r⌋₊ have hjlo : (j : ℝ) ≤ -y - r := Nat.floor_le (by linarith) have hjhi : -y - r < (j : ℝ) + 1 := Nat.lt_floor_add_one _ have htail : -(r + (j : ℝ) + 1) ≤ y := by linarith calc _ ≤ ENNReal.ofReal (fordDeficitWeight r j) := by apply ENNReal.ofReal_le_ofReal rw [fordDeficitWeight_eq_exp] apply exp_le_exp.mpr have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) nlinarith _ = (if -(r + (j : ℝ) + 1) ≤ y then ENNReal.ofReal (fordDeficitWeight r j) else 0) := (if_pos htail).symm _ ≤ _ := ENNReal.le_tsum j theorem fordDeficit_exp_integrable (k : ℕ) (v : ℝ) : IntegrableOn (fun x : Fin k → ℝ ↦ exp (log 2 * fordCubeDeficit v x)) (Icc (fun _ ↦ 0) (fun _ ↦ 1)) := by let S : Set (Fin k → ℝ) := Icc (fun _ ↦ 0) (fun _ ↦ 1) have : IsFiniteMeasure (volume.restrict S) := ⟨by rw [Measure.restrict_apply_univ] change volume (Icc (fun _ : Fin k ↦ (0 : ℝ)) (fun _ ↦ 1)) < ∞ rw [ford_unitCube_volume] exact ENNReal.one_lt_top⟩ have hm : Measurable (fun x : Fin k → ℝ ↦ exp (log 2 * fordCubeDeficit v x)) := (measurable_const.mul (fordCubeDeficit_measurable k v)).exp apply (integrable_const (μ := volume.restrict S) (1 : ℝ)).mono' hm.aestronglyMeasurable apply ae_of_all intro x rw [Real.norm_eq_abs, abs_of_pos (exp_pos _)] apply exp_le_one_iff.mpr exact mul_nonpos_of_nonneg_of_nonpos (log_nonneg (by norm_num)) (fordCubeDeficit_nonpos v x) theorem ford_deficit_tail_polynomial (b : ℝ) (j : ℕ) : (max 0 b + j + 2) * (max 0 b - b + j + 2) ^ 2 ≤ 2 * (1 + b ^ 2) * ((j : ℝ) + 2) ^ 3 := by have hj : (0 : ℝ) ≤ j := Nat.cast_nonneg j by_cases hb : 0 ≤ b · rw [max_eq_right hb] have hlin : b + j + 2 ≤ (b + 1) * ((j : ℝ) + 2) := by nlinarith have hb2 : b + 1 ≤ 2 * (1 + b ^ 2) := by nlinarith [sq_nonneg (b - 1 / 2)] have hm := mul_le_mul_of_nonneg_right hlin (sq_nonneg ((j : ℝ) + 2)) have hm2 := mul_le_mul_of_nonneg_right hb2 (pow_nonneg (show (0 : ℝ) ≤ j + 2 by positivity) 3) nlinarith only [hm, hm2] · have hb0 : b ≤ 0 := le_of_not_ge hb rw [max_eq_left hb0] have hlin : (j : ℝ) + 2 - b ≤ (1 - b) * ((j : ℝ) + 2) := by nlinarith have hsq : ((j : ℝ) + 2 - b) ^ 2 ≤ ((1 - b) * ((j : ℝ) + 2)) ^ 2 := pow_le_pow_left₀ (by linarith) hlin 2 have hb2 : (1 - b) ^ 2 ≤ 2 * (1 + b ^ 2) := by nlinarith [sq_nonneg (b + 1)] have hm := mul_le_mul_of_nonneg_left hsq (show (0 : ℝ) ≤ j + 2 by positivity) have hm2 := mul_le_mul_of_nonneg_right hb2 (pow_nonneg (show (0 : ℝ) ≤ j + 2 by positivity) 3) nlinarith only [hm, hm2] theorem fordDeficit_exp_lintegral_le_layers {k : ℕ} (hk : 0 < k) {v : ℝ} (hv : 0 ≤ v) : (∫⁻ x : Fin k → ℝ in Icc (fun _ ↦ 0) (fun _ ↦ 1), ENNReal.ofReal (exp (log 2 * fordCubeDeficit v x))) ≤ ∑' j : ℕ, ENNReal.ofReal (fordDeficitWeight (max 0 ((k : ℝ) - v)) j) * volume (Icc (fun _ : Fin k ↦ (0 : ℝ)) (fun _ ↦ 1) ∩ {x | -(max 0 ((k : ℝ) - v) + j + 1) ≤ fordCubeDeficit v x}) := by classical let r := max 0 ((k : ℝ) - v) let S : Set (Fin k → ℝ) := Icc (fun _ ↦ 0) (fun _ ↦ 1) let f : ℕ → (Fin k → ℝ) → ℝ≥0∞ := fun j x ↦ if -(r + j + 1) ≤ fordCubeDeficit v x then ENNReal.ofReal (fordDeficitWeight r j) else 0 have hf (j : ℕ) : Measurable (f j) := measurable_const.ite (measurableSet_le measurable_const (fordCubeDeficit_measurable k v)) measurable_const calc _ ≤ ∫⁻ x, ∑' j, f j x ∂volume.restrict S := by apply lintegral_mono_ae filter_upwards [ae_restrict_mem measurableSet_Icc] with x hx have h := fordCubeDeficit_le_min hk hv hx have hr : min 0 (v - (k : ℝ)) = -r := by dsimp [r] by_cases hb : 0 ≤ (k : ℝ) - v · rw [max_eq_right hb, min_eq_right (by linarith)] ring · rw [max_eq_left (le_of_not_ge hb), min_eq_left (by linarith)] ring exact fordDeficit_exp_le_layers (hr ▸ h) _ = ∑' j, ∫⁻ x, f j x ∂volume.restrict S := lintegral_tsum (fun j ↦ (hf j).aemeasurable) _ = _ := by apply tsum_congr intro j have htail : MeasurableSet {x : Fin k → ℝ | -(r + j + 1) ≤ fordCubeDeficit v x} := measurableSet_le measurable_const (fordCubeDeficit_measurable k v) change (∫⁻ x, {x : Fin k → ℝ | -(r + j + 1) ≤ fordCubeDeficit v x}.indicator (fun _ ↦ ENNReal.ofReal (fordDeficitWeight r j)) x ∂volume.restrict S) = _ rw [lintegral_indicator htail, setLIntegral_const, Measure.restrict_apply htail] rw [inter_comm] theorem fordDeficit_layer_probability_bound {k : ℕ} (hk : 0 < k) (v : ℝ) (j : ℕ) : volume (Icc (fun _ : Fin k ↦ (0 : ℝ)) (fun _ ↦ 1) ∩ {x | -(max 0 ((k : ℝ) - v) + j + 1) ≤ fordCubeDeficit v x}) ≤ ENNReal.ofReal (72 * (1 + ((k : ℝ) - v) ^ 2) / k * ((j : ℝ) + 2) ^ 3) := by let r := max 0 ((k : ℝ) - v) have hr : 0 ≤ r := le_max_left _ _ have hb : (k : ℝ) - v ≤ r := le_max_right _ _ have hs : 0 ≤ r + (j : ℝ) + 1 := by positivity have hw : 0 ≤ r + (j : ℝ) + 1 + v - k := by nlinarith [Nat.cast_nonneg (α := ℝ) j] have htail := fordCubeDeficit_tail_bound hk hs hw have hpoly := ford_deficit_tail_polynomial ((k : ℝ) - v) j have hden : (0 : ℝ) ≤ k := Nat.cast_nonneg k have hnum : 36 * (r + (j : ℝ) + 1 + 1) * (r + (j : ℝ) + 1 + v - k + 1) ^ 2 ≤ 72 * (1 + ((k : ℝ) - v) ^ 2) * ((j : ℝ) + 2) ^ 3 := by dsimp [r] nlinarith only [hpoly] have hquot := div_le_div_of_nonneg_right hnum hden have hfinite : volume (Icc (fun _ : Fin k ↦ (0 : ℝ)) (fun _ ↦ 1) ∩ {x | -(r + j + 1) ≤ fordCubeDeficit v x}) ≠ ∞ := by apply measure_ne_top_of_subset inter_subset_left rw [ford_unitCube_volume] exact ENNReal.one_ne_top rw [← ENNReal.ofReal_toReal hfinite] apply ENNReal.ofReal_le_ofReal calc _ ≤ _ := htail _ ≤ _ := hquot.trans_eq (by ring) theorem fordDeficit_weighted_cubic_sum (r D : ℝ) (hD : 0 ≤ D) : (∑' j : ℕ, ENNReal.ofReal (fordDeficitWeight r j) * ENNReal.ofReal (D * ((j : ℝ) + 2) ^ 3)) ≤ ENNReal.ofReal (192 * exp (-log 2 * r) * D) := by have hED : 0 ≤ exp (-log 2 * r) * D := mul_nonneg (exp_pos _).le hD calc _ = ENNReal.ofReal (exp (-log 2 * r) * D) * ∑' j : ℕ, ENNReal.ofReal ((1 / 2 : ℝ) ^ j * ((j : ℝ) + 2) ^ 3) := by rw [← ENNReal.tsum_mul_left] apply tsum_congr intro j rw [← ENNReal.ofReal_mul (show 0 ≤ fordDeficitWeight r j by unfold fordDeficitWeight; positivity), ← ENNReal.ofReal_mul hED] congr 1 unfold fordDeficitWeight ring _ ≤ ENNReal.ofReal (exp (-log 2 * r) * D) * 192 := mul_le_mul_of_nonneg_left ford_geometric_cubic_sum_bound (by positivity) _ = _ := by have h192 : (192 : ℝ≥0∞) = ENNReal.ofReal (192 : ℝ) := by norm_num rw [h192, ← ENNReal.ofReal_mul hED] congr 1 ring theorem fordDeficit_exp_lintegral_bound {k : ℕ} (hk : 0 < k) {v : ℝ} (hv : 0 ≤ v) : (∫⁻ x : Fin k → ℝ in Icc (fun _ ↦ 0) (fun _ ↦ 1), ENNReal.ofReal (exp (log 2 * fordCubeDeficit v x))) ≤ ENNReal.ofReal (13824 * (1 + ((k : ℝ) - v) ^ 2) / k * exp (-log 2 * max 0 ((k : ℝ) - v))) := by let r := max 0 ((k : ℝ) - v) let D := 72 * (1 + ((k : ℝ) - v) ^ 2) / k have hD : 0 ≤ D := by dsimp [D]; positivity calc _ ≤ ∑' j : ℕ, ENNReal.ofReal (fordDeficitWeight r j) * volume (Icc (fun _ : Fin k ↦ (0 : ℝ)) (fun _ ↦ 1) ∩ {x | -(r + j + 1) ≤ fordCubeDeficit v x}) := fordDeficit_exp_lintegral_le_layers hk hv _ ≤ ∑' j : ℕ, ENNReal.ofReal (fordDeficitWeight r j) * ENNReal.ofReal (D * ((j : ℝ) + 2) ^ 3) := by apply ENNReal.tsum_le_tsum intro j exact mul_le_mul_of_nonneg_left (fordDeficit_layer_probability_bound hk v j) (by positivity) _ ≤ ENNReal.ofReal (192 * exp (-log 2 * r) * D) := fordDeficit_weighted_cubic_sum r D hD _ = _ := by congr 1 dsimp [r, D] ring noncomputable def fordDeficitMoment (k : ℕ) (v : ℝ) : ℝ := ∫ x : Fin k → ℝ in Icc (fun _ ↦ 0) (fun _ ↦ 1), exp (log 2 * fordCubeDeficit v x) theorem fordDeficitMoment_shifted_bound {k : ℕ} (hk : 0 < k) {v : ℝ} (hv : 0 ≤ v) : fordDeficitMoment k v ≤ 13824 * (1 + ((k : ℝ) - v) ^ 2) / k * exp (-log 2 * max 0 ((k : ℝ) - v)) := by have h := ENNReal.toReal_mono ENNReal.ofReal_ne_top (fordDeficit_exp_lintegral_bound hk hv) rw [ENNReal.toReal_ofReal (by positivity)] at h unfold fordDeficitMoment rw [integral_eq_lintegral_of_nonneg_ae (ae_of_all _ fun _ ↦ (exp_pos _).le) (fordDeficit_exp_integrable k v).aestronglyMeasurable] exact h theorem ford_deficit_exponential_cutoff (b : ℝ) : exp (-log 2 * max 0 b) ≤ 2 / (1 + exp (log 2 * b)) := by have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) apply (le_div_iff₀ (by positivity : 0 < 1 + exp (log 2 * b))).mpr by_cases hb : 0 ≤ b · rw [max_eq_right hb] have he : exp (-log 2 * b) * exp (log 2 * b) = 1 := by rw [← exp_add, show -log 2 * b + log 2 * b = 0 by ring, exp_zero] have hsmall : exp (-log 2 * b) ≤ 1 := exp_le_one_iff.mpr (by nlinarith) nlinarith · have hb0 : b ≤ 0 := le_of_not_ge hb rw [max_eq_left hb0, mul_zero, exp_zero, one_mul] have hsmall : exp (log 2 * b) ≤ 1 := exp_le_one_iff.mpr (by nlinarith) linarith /-- Actual unit-cube expectation, with an explicit absolute constant. -/ theorem fordDeficitMoment_bound {k : ℕ} (hk : 0 < k) {v : ℝ} (hv : 0 ≤ v) : fordDeficitMoment k v ≤ 27648 * (1 + ((k : ℝ) - v) ^ 2) / ((k : ℝ) * (1 + (2 : ℝ) ^ ((k : ℝ) - v))) := by calc _ ≤ 13824 * (1 + ((k : ℝ) - v) ^ 2) / k * exp (-log 2 * max 0 ((k : ℝ) - v)) := fordDeficitMoment_shifted_bound hk hv _ ≤ 13824 * (1 + ((k : ℝ) - v) ^ 2) / k * (2 / (1 + exp (log 2 * ((k : ℝ) - v)))) := mul_le_mul_of_nonneg_left (ford_deficit_exponential_cutoff _) (by positivity) _ = _ := by rw [rpow_def_of_pos (by norm_num : (0 : ℝ) < 2)] rw [div_mul_div_comm] ring end Erdos859Verification end /- Inlined development module: FordSupportPacking.lean -/ section /- A finite separated cover whose size is paid for by interval-support volume. -/ namespace Erdos859Verification open Finset MeasureTheory def finiteStartIntervalSupport (S : Finset ℝ) (d : ℝ) : Set ℝ := ⋃ a ∈ S, Set.Icc a (a + d) theorem isCompact_finiteStartIntervalSupport (S : Finset ℝ) (d : ℝ) : IsCompact (finiteStartIntervalSupport S d) := S.isCompact_biUnion (fun _ _ ↦ isCompact_Icc) /-- Greedily keep a new point precisely when it is farther than `d` from every point already kept. The final set covers all starting points. -/ theorem exists_finite_separated_net (S : Finset ℝ) {d : ℝ} (hd : 0 ≤ d) : ∃ J ⊆ S, (∀ a ∈ J, ∀ b ∈ J, a ≠ b → d < |a - b|) ∧ ∀ a ∈ S, ∃ b ∈ J, |a - b| ≤ d := by classical induction S using Finset.induction_on with | empty => exact ⟨∅, by simp, by simp, by simp⟩ | @insert a S ha ih => obtain ⟨J, hJS, hsep, hcover⟩ := ih by_cases hnear : ∃ b ∈ J, |a - b| ≤ d · refine ⟨J, hJS.trans (subset_insert a S), hsep, ?_⟩ intro x hx rcases Finset.mem_insert.mp hx with rfl | hx · exact hnear · exact hcover x hx · have hfar : ∀ b ∈ J, d < |a - b| := by intro b hb exact lt_of_not_ge (fun h ↦ hnear ⟨b, hb, h⟩) refine ⟨insert a J, insert_subset_insert a hJS, ?_, ?_⟩ · intro x hx y hy hxy rcases Finset.mem_insert.mp hx with hxa | hxJ · subst x rcases Finset.mem_insert.mp hy with hya | hyJ · exact (hxy hya.symm).elim · exact hfar y hyJ · rcases Finset.mem_insert.mp hy with hya | hyJ · subst y simpa only [abs_sub_comm] using hfar x hxJ · exact hsep x hxJ y hyJ hxy · intro x hx rcases Finset.mem_insert.mp hx with hxa | hxS · subst x exact ⟨a, mem_insert_self a J, by simpa using hd⟩ · obtain ⟨b, hb, hxb⟩ := hcover x hxS exact ⟨b, mem_insert_of_mem hb, hxb⟩ theorem separated_start_intervals_disjoint {J : Finset ℝ} {d : ℝ} (hsep : ∀ a ∈ J, ∀ b ∈ J, a ≠ b → d < |a - b|) : Set.PairwiseDisjoint (J : Set ℝ) (fun a ↦ Set.Icc a (a + d)) := by intro a ha b hb hab apply Set.disjoint_left.mpr intro x hx hy have hdist : |a - b| ≤ d := abs_le.mpr ⟨by linarith [hx.2, hy.1], by linarith [hx.1, hy.2]⟩ exact (not_le_of_gt (hsep a ha b hb hab)) hdist theorem separated_start_intervals_volume {J : Finset ℝ} {d : ℝ} (hd : 0 ≤ d) (hsep : ∀ a ∈ J, ∀ b ∈ J, a ≠ b → d < |a - b|) : volume.real (finiteStartIntervalSupport J d) = (J.card : ℝ) * d := by unfold finiteStartIntervalSupport rw [measureReal_biUnion_finset (separated_start_intervals_disjoint hsep) (fun _ _ ↦ measurableSet_Icc) (fun _ _ ↦ isCompact_Icc.measure_ne_top)] simp only [Real.volume_real_Icc, add_sub_cancel_left, max_eq_left hd, sum_const, nsmul_eq_mul] theorem separated_start_card_mul_le {S J : Finset ℝ} {d : ℝ} (hd : 0 ≤ d) (hJS : J ⊆ S) (hsep : ∀ a ∈ J, ∀ b ∈ J, a ≠ b → d < |a - b|) : (J.card : ℝ) * d ≤ volume.real (finiteStartIntervalSupport S d) := by rw [← separated_start_intervals_volume hd hsep] apply measureReal_mono _ (isCompact_finiteStartIntervalSupport S d).measure_ne_top intro x hx obtain ⟨a, ha, hax⟩ := Set.mem_iUnion₂.mp hx exact Set.mem_iUnion₂.mpr ⟨a, hJS ha, hax⟩ theorem start_interval_net_covers {S J : Finset ℝ} {d : ℝ} (hcover : ∀ a ∈ S, ∃ b ∈ J, |a - b| ≤ d) : finiteStartIntervalSupport S d ⊆ ⋃ b ∈ J, Set.Icc (b - d) (b + 2 * d) := by intro x hx obtain ⟨a, ha, hax⟩ := Set.mem_iUnion₂.mp hx obtain ⟨b, hb, hab⟩ := hcover a ha obtain ⟨hablo, habhi⟩ := abs_le.mp hab exact Set.mem_iUnion₂.mpr ⟨b, hb, by constructor <;> linarith [hax.1, hax.2]⟩ /-- A length-`d` interval support admits a cover by `3d` intervals, one per selected starting point, with at most support-volume divided by `d` members. -/ theorem exists_interval_support_packing (S : Finset ℝ) {d : ℝ} (hd : 0 < d) : ∃ J ⊆ S, (∀ a ∈ J, ∀ b ∈ J, a ≠ b → d < |a - b|) ∧ (∀ a ∈ S, ∃ b ∈ J, |a - b| ≤ d) ∧ (finiteStartIntervalSupport S d ⊆ ⋃ b ∈ J, Set.Icc (b - d) (b + 2 * d)) ∧ (J.card : ℝ) * d ≤ volume.real (finiteStartIntervalSupport S d) := by obtain ⟨J, hJS, hsep, hcover⟩ := exists_finite_separated_net S hd.le exact ⟨J, hJS, hsep, hcover, start_interval_net_covers hcover, separated_start_card_mul_le hd.le hJS hsep⟩ theorem finiteIntervalSupport_eq_start_image {ι : Type*} [Fintype ι] (atom : ι → ℝ) (d : ℝ) : finiteIntervalSupport atom d = finiteStartIntervalSupport (univ.image atom) d := by classical ext x constructor · intro hx obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hx exact Set.mem_iUnion₂.mpr ⟨atom i, mem_image.mpr ⟨i, mem_univ i, rfl⟩, hi⟩ · intro hx obtain ⟨a, ha, hax⟩ := Set.mem_iUnion₂.mp hx obtain ⟨i, _, rfl⟩ := mem_image.mp ha exact Set.mem_iUnion.mpr ⟨i, hax⟩ /-- The packing statement permits repeated original atoms: the centers are selected from their finite image, so duplicates do not cost extra intervals. -/ theorem exists_finiteIntervalSupport_packing {ι : Type*} [Fintype ι] (atom : ι → ℝ) {d : ℝ} (hd : 0 < d) : ∃ J : Finset ℝ, (∀ b ∈ J, ∃ i, atom i = b) ∧ (∀ a ∈ J, ∀ b ∈ J, a ≠ b → d < |a - b|) ∧ (∀ i, ∃ b ∈ J, |atom i - b| ≤ d) ∧ (finiteIntervalSupport atom d ⊆ ⋃ b ∈ J, Set.Icc (b - d) (b + 2 * d)) ∧ (J.card : ℝ) ≤ volume.real (finiteIntervalSupport atom d) / d := by classical obtain ⟨J, hJS, hsep, hcover, hsub, hvol⟩ := exists_interval_support_packing (univ.image atom) hd rw [← finiteIntervalSupport_eq_start_image atom d] at hsub hvol refine ⟨J, ?_, hsep, ?_, hsub, (le_div_iff₀ hd).mpr hvol⟩ · intro b hb obtain ⟨i, _, hi⟩ := mem_image.mp (hJS hb) exact ⟨i, hi⟩ · intro i exact hcover (atom i) (mem_image.mpr ⟨i, mem_univ i, rfl⟩) end Erdos859Verification end /- Inlined development module: FordSupportPrimeMass.lean -/ section /- Reciprocal-prime mass is controlled by the volume of a finite interval support. -/ namespace Erdos859Verification open Finset Real MeasureTheory open scoped Classical /-- There is at most one prime at any specified logarithmic endpoint. -/ theorem prime_log_endpoint_mass_le (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime) (a : ℝ) : (∑ p ∈ P.filter (fun p : ℕ ↦ log (p : ℝ) = a), 1 / (p : ℝ)) ≤ exp (-a) := by classical let Q := P.filter (fun p : ℕ ↦ log (p : ℝ) = a) have hcard : Q.card ≤ 1 := by apply Finset.card_le_one.mpr intro p hp q hq obtain ⟨hpP, hp⟩ := mem_filter.mp hp obtain ⟨hqP, hq⟩ := mem_filter.mp hq have heq : (p : ℝ) = q := log_injOn_pos (Set.mem_Ioi.mpr (by exact_mod_cast (hP p hpP).pos)) (Set.mem_Ioi.mpr (by exact_mod_cast (hP q hqP).pos)) (hp.trans hq.symm) exact_mod_cast heq have hsum : (∑ p ∈ Q, 1 / (p : ℝ)) = (Q.card : ℝ) * exp (-a) := by calc _ = ∑ _p ∈ Q, exp (-a) := by apply sum_congr rfl intro p hp obtain ⟨hpP, hp⟩ := mem_filter.mp hp rw [← hp, exp_neg, exp_log (by exact_mod_cast (hP p hpP).pos)] simp only [one_div] _ = _ := by simp change (∑ p ∈ Q, 1 / (p : ℝ)) ≤ _ rw [hsum] have hcardR : (Q.card : ℝ) ≤ 1 := by exact_mod_cast hcard nlinarith [exp_pos (-a)] theorem prime_closed_log_interval_mass_upper (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime) {a b : ℝ} (ha : log 2 ≤ a) (hab : a ≤ b) : (∑ p ∈ P.filter (fun p : ℕ ↦ log (p : ℝ) ∈ Set.Icc a b), 1 / (p : ℝ)) ≤ (b - a + 2 * mertensErrorConstant + 1) / a := by classical have ha0 : 0 < a := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le ha have hsplit : (∑ p ∈ P.filter (fun p : ℕ ↦ log (p : ℝ) ∈ Set.Icc a b), 1 / (p : ℝ)) = (∑ p ∈ P.filter (fun p : ℕ ↦ log (p : ℝ) = a), 1 / (p : ℝ)) + ∑ p ∈ P.filter (fun p : ℕ ↦ a < log (p : ℝ) ∧ log (p : ℝ) ≤ b), 1 / (p : ℝ) := by simp only [sum_filter, ← sum_add_distrib, Set.mem_Icc] apply sum_congr rfl intro p _ by_cases heq : log (p : ℝ) = a · simp [heq, hab] · by_cases hi : a < log (p : ℝ) ∧ log (p : ℝ) ≤ b · simp [heq, hi, hi.1.le] · have hn : ¬(a ≤ log (p : ℝ) ∧ log (p : ℝ) ≤ b) := by intro hh exact hi ⟨lt_of_le_of_ne hh.1 (Ne.symm heq), hh.2⟩ simp [heq, hi, hn] have hopen : (∑ p ∈ P.filter (fun p : ℕ ↦ a < log (p : ℝ) ∧ log (p : ℝ) ≤ b), 1 / (p : ℝ)) ≤ primeLogWindowMass a b := by apply sum_le_sum_of_subset_of_nonneg · intro p hp obtain ⟨hpP, hp⟩ := mem_filter.mp hp exact mem_primeLogWindow.mpr ⟨hP p hpP, hp⟩ · intro _ _ _ positivity have hend : exp (-a) ≤ 1 / a := by rw [exp_neg, ← one_div] exact one_div_le_one_div_of_le ha0 (by linarith [add_one_le_exp a]) rw [hsplit] calc _ ≤ exp (-a) + primeLogWindowMass a b := add_le_add (prime_log_endpoint_mass_le P hP a) hopen _ ≤ 1 / a + (b - a + 2 * mertensErrorConstant) / a := add_le_add hend (primeLogWindowMass_upper ha hab) _ = _ := by ring /-- Clipping a covering interval at the threshold never increases its length. -/ theorem prime_clipped_cover_interval_mass_upper (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime) {v d : ℝ} (hv : log 2 ≤ v) (hd : 0 ≤ d) (c : ℝ) : (∑ p ∈ P.filter (fun p : ℕ ↦ log (p : ℝ) ∈ Set.Icc (max v (c - d)) (c + 2*d)), 1 / (p : ℝ)) ≤ (3*d + 2*mertensErrorConstant + 1) / v := by classical have hv0 : 0 < v := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv have hnum : 0 ≤ 3*d + 2*mertensErrorConstant + 1 := by positivity [mertensErrorConstant_pos] by_cases horder : max v (c-d) ≤ c+2*d · calc _ ≤ (c+2*d-max v (c-d)+2*mertensErrorConstant+1) / max v (c-d) := prime_closed_log_interval_mass_upper P hP (hv.trans (le_max_left _ _)) horder _ ≤ (3*d+2*mertensErrorConstant+1) / max v (c-d) := div_le_div_of_nonneg_right (by linarith [le_max_right v (c-d)]) (hv0.le.trans (le_max_left _ _)) _ ≤ _ := div_le_div_of_nonneg_left hnum hv0 (le_max_left _ _) · have hempty : P.filter (fun p : ℕ ↦ log (p : ℝ) ∈ Set.Icc (max v (c-d)) (c+2*d)) = ∅ := by apply filter_eq_empty_iff.mpr intro p _ hp exact horder (hp.1.trans hp.2) rw [hempty, sum_empty] exact div_nonneg hnum hv0.le /-- This estimate is uniform in the finite prime universe and in all atom locations. Its cost is proportional to support volume, not the number of atoms. -/ theorem prime_finiteIntervalSupport_mass_upper {ι : Type*} [Fintype ι] (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime) (atom : ι → ℝ) {v d : ℝ} (hv : log 2 ≤ v) (hd : 0 < d) : (∑ p ∈ P.filter (fun p : ℕ ↦ v ≤ log (p : ℝ) ∧ log (p : ℝ) ∈ finiteIntervalSupport atom d), 1 / (p : ℝ)) ≤ ((3*d + 2*mertensErrorConstant + 1) / d) * volume.real (finiteIntervalSupport atom d) / v := by classical obtain ⟨J, _hatoms, _hsep, _hnet, hcover, hcard⟩ := exists_finiteIntervalSupport_packing atom hd let covered : ℝ → ℕ → Prop := fun c p ↦ log (p : ℝ) ∈ Set.Icc (max v (c-d)) (c+2*d) have hunion : (∑ p ∈ P.filter (fun p : ℕ ↦ v ≤ log (p : ℝ) ∧ log (p : ℝ) ∈ finiteIntervalSupport atom d), 1 / (p : ℝ)) ≤ ∑ c ∈ J, ∑ p ∈ P.filter (covered c), 1 / (p : ℝ) := by simp only [sum_filter] rw [sum_comm] apply sum_le_sum intro p _ by_cases hp : v ≤ log (p : ℝ) ∧ log (p : ℝ) ∈ finiteIntervalSupport atom d · rw [if_pos hp] obtain ⟨c, hc, hpc⟩ := Set.mem_iUnion₂.mp (hcover hp.2) have hpc' : covered c p := ⟨max_le hp.1 hpc.1, hpc.2⟩ have h := single_le_sum (f := fun c ↦ if covered c p then 1/(p:ℝ) else 0) (fun _ _ ↦ by split_ifs <;> positivity) hc simpa only [if_pos hpc'] using h · rw [if_neg hp] exact sum_nonneg (fun _ _ ↦ by split_ifs <;> positivity) have hv0 : 0 < v := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hv have hconst : 0 ≤ (3*d+2*mertensErrorConstant+1)/v := by positivity [mertensErrorConstant_pos] calc _ ≤ ∑ c ∈ J, ∑ p ∈ P.filter (covered c), 1/(p:ℝ) := hunion _ ≤ ∑ _c ∈ J, (3*d+2*mertensErrorConstant+1)/v := sum_le_sum (fun c _ ↦ prime_clipped_cover_interval_mass_upper P hP hv hd.le c) _ = (J.card : ℝ) * ((3*d+2*mertensErrorConstant+1)/v) := by simp _ ≤ (volume.real (finiteIntervalSupport atom d)/d) * ((3*d+2*mertensErrorConstant+1)/v) := mul_le_mul_of_nonneg_right hcard hconst _ = _ := by ring end Erdos859Verification end /- Inlined development module: FordOccupancyEnvelope.lean -/ section /- The deterministic occupancy estimate for the subset envelope. -/ open Finset Real MeasureTheory open scoped ENNReal namespace Erdos859Verification noncomputable def fordBinOccupancy {k : ℕ} (v : ℝ) (x : Fin k → ℝ) (b : ℕ) : ℕ := (univ.filter fun i ↦ ⌊v * x i⌋₊ = b).card theorem ford_exp_log_two_nat (j : ℕ) : exp (log 2 * (j : ℝ)) = (2 : ℝ) ^ j := by rw [mul_comm, exp_nat_mul, exp_log (by norm_num)] theorem ford_floor_weight_sum {ι : Type*} [DecidableEq ι] (s : Finset ι) (y : ι → ℝ) {t R : ℝ} (ht : 0 ≤ t) (hR : 0 ≤ R) (hyt : ∀ i ∈ s, y i ≤ t) (hocc : ∀ b : ℕ, ((s.filter fun i ↦ ⌊y i⌋₊ = b).card : ℝ) ≤ R) : (∑ i ∈ s, exp (log 2 * y i)) ≤ 4 * R * exp (log 2 * t) := by have hlog : 0 ≤ log (2 : ℝ) := log_nonneg (by norm_num) have hmap : ∀ i ∈ s, ⌊y i⌋₊ ∈ range (⌊t⌋₊ + 1) := by intro i hi exact mem_range.mpr (Nat.lt_succ_of_le (Nat.floor_mono (hyt i hi))) calc _ = ∑ b ∈ range (⌊t⌋₊ + 1), ∑ i ∈ s.filter (fun i ↦ ⌊y i⌋₊ = b), exp (log 2 * y i) := (sum_fiberwise_of_maps_to hmap _).symm _ ≤ ∑ b ∈ range (⌊t⌋₊ + 1), R * (2 : ℝ) ^ (b + 1) := by apply sum_le_sum intro b _ calc _ ≤ ∑ _i ∈ s.filter (fun i ↦ ⌊y i⌋₊ = b), (2 : ℝ) ^ (b + 1) := by apply sum_le_sum intro i hi have hiy : y i ≤ (b : ℝ) + 1 := by simpa only [(mem_filter.mp hi).2] using (Nat.lt_floor_add_one (y i)).le rw [← ford_exp_log_two_nat] exact exp_le_exp.mpr (mul_le_mul_of_nonneg_left (by exact_mod_cast hiy) hlog) _ = ((s.filter fun i ↦ ⌊y i⌋₊ = b).card : ℝ) * (2 : ℝ) ^ (b + 1) := by rw [sum_const, nsmul_eq_mul] _ ≤ R * (2 : ℝ) ^ (b + 1) := mul_le_mul_of_nonneg_right (hocc b) (by positivity) _ ≤ 4 * R * (2 : ℝ) ^ ⌊t⌋₊ := by simp_rw [pow_succ] rw [← mul_sum] rw [← sum_mul, geom_sum_eq (by norm_num : (2 : ℝ) ≠ 1)] norm_num only [show (2 : ℝ) - 1 = 1 by norm_num, div_one, pow_succ] nlinarith _ ≤ _ := by apply mul_le_mul_of_nonneg_left _ (by positivity) rw [← ford_exp_log_two_nat] exact exp_le_exp.mpr (mul_le_mul_of_nonneg_left (Nat.floor_le ht) hlog) theorem fordSubsetEnvelope_occupancy_coordinate {k : ℕ} {v R : ℝ} (hv : 0 ≤ v) (hR : 0 ≤ R) (x : Fin k → ℝ) (hx : ∀ i, 0 ≤ x i) (hocc : ∀ b : ℕ, (fordBinOccupancy v x b : ℝ) ≤ R) (j : Fin k) : fordSubsetEnvelope (fun i ↦ log 2 * (v * x i)) ≤ (4 * R + 1) * exp (log 2 * (v * fordSortedTuple x j - ((j.val : ℝ) + 1))) := by classical let I := (Iic j).image (Tuple.sort x) have hcard : I.card = j.val + 1 := by rw [card_image_of_injective _ (Tuple.sort x).injective] exact Fin.card_Iic j have ht : 0 ≤ v * fordSortedTuple x j := mul_nonneg hv (hx _) have hsum := ford_floor_weight_sum I (fun i ↦ v * x i) ht hR (by intro i hi obtain ⟨a, ha, rfl⟩ := mem_image.mp hi exact mul_le_mul_of_nonneg_left (Tuple.monotone_sort x (mem_Iic.mp ha)) hv) (by intro b apply le_trans _ (hocc b) exact_mod_cast card_le_card (show I.filter (fun i ↦ ⌊v * x i⌋₊ = b) ⊆ univ.filter (fun i ↦ ⌊v * x i⌋₊ = b) from fun i hi ↦ mem_filter.mpr ⟨mem_univ i, (mem_filter.mp hi).2⟩)) have he : 1 ≤ exp (log 2 * (v * fordSortedTuple x j)) := one_le_exp_iff.mpr (mul_nonneg (log_nonneg (by norm_num)) ht) calc _ ≤ (1 + ∑ i ∈ I, exp (log 2 * (v * x i))) / (2 : ℝ) ^ I.card := fordSubsetEnvelope_le _ I _ ≤ ((4 * R + 1) * exp (log 2 * (v * fordSortedTuple x j))) / (2 : ℝ) ^ I.card := by apply div_le_div_of_nonneg_right _ (by positivity) nlinarith _ = _ := by rw [hcard, mul_sub, exp_sub] have hexp : exp (log 2 * ((j.val : ℝ) + 1)) = (2 : ℝ) ^ (j.val + 1) := by simpa only [Nat.cast_add, Nat.cast_one] using ford_exp_log_two_nat (j.val + 1) rw [hexp] ring /-- Bounded bin occupancy controls the envelope by the actual sorted deficit. -/ theorem fordSubsetEnvelope_le_deficit {k : ℕ} {v R : ℝ} (hv : 0 ≤ v) (hR : 0 ≤ R) (x : Fin k → ℝ) (hx : ∀ i, 0 ≤ x i) (hocc : ∀ b : ℕ, (fordBinOccupancy v x b : ℝ) ≤ R) : fordSubsetEnvelope (fun i ↦ log 2 * (v * x i)) ≤ (4 * R + 1) * exp (log 2 * fordCubeDeficit v x) := by classical have hm := min'_mem (insert 0 (univ.image fun i : Fin k ↦ v * fordSortedTuple x i - ((i.val : ℝ) + 1))) (by simp) change fordCubeDeficit v x ∈ insert 0 (univ.image fun i : Fin k ↦ v * fordSortedTuple x i - ((i.val : ℝ) + 1)) at hm rcases mem_insert.mp hm with hzero | hcoord · rw [hzero, mul_zero, exp_zero, mul_one] exact (fordSubsetEnvelope_le_one _).trans (by linarith) · obtain ⟨j, _, hj⟩ := mem_image.mp hcoord rw [← hj] exact fordSubsetEnvelope_occupancy_coordinate hv hR x hx hocc j /-- The elementary endpoint bound requires no occupancy hypothesis. -/ theorem fordSubsetEnvelope_le_endpoint {k : ℕ} {v : ℝ} (hv : 0 ≤ v) (x : Fin k → ℝ) (hx : ∀ i, x i ≤ 1) : fordSubsetEnvelope (fun i ↦ log 2 * (v * x i)) ≤ min 1 (((k : ℝ) + 1) * exp (log 2 * (v - k))) := by apply le_min (fordSubsetEnvelope_le_one _) have he : 1 ≤ exp (log 2 * v) := one_le_exp_iff.mpr (mul_nonneg (log_nonneg (by norm_num)) hv) have hsum : (∑ i : Fin k, exp (log 2 * (v * x i))) ≤ k * exp (log 2 * v) := by calc _ ≤ ∑ _i : Fin k, exp (log 2 * v) := by apply sum_le_sum intro i _ apply exp_le_exp.mpr exact mul_le_mul_of_nonneg_left (by nlinarith [hx i]) (log_nonneg (by norm_num)) _ = _ := by simp calc _ ≤ (1 + ∑ i : Fin k, exp (log 2 * (v * x i))) / (2 : ℝ) ^ k := by simpa only [card_univ, Fintype.card_fin] using fordSubsetEnvelope_le (fun i ↦ log 2 * (v * x i)) univ _ ≤ (((k : ℝ) + 1) * exp (log 2 * v)) / (2 : ℝ) ^ k := by apply div_le_div_of_nonneg_right _ (by positivity) nlinarith _ = _ := by rw [mul_sub, exp_sub, ford_exp_log_two_nat] ring end Erdos859Verification end /- Inlined development module: FordOccupancyProbability.lean -/ section /- Actual unit-cube bounds for crowded bins, including the endpoint bin. -/ open Finset Real MeasureTheory open scoped ENNReal namespace Erdos859Verification def fordCoordinateBox {k : ℕ} (I : Finset (Fin k)) (a b : ℝ) : Set (Fin k → ℝ) := Set.Icc (fun i ↦ if i ∈ I then a else 0) (fun i ↦ if i ∈ I then b else 1) theorem fordCoordinateBox_volume {k : ℕ} (I : Finset (Fin k)) (a b : ℝ) : volume (fordCoordinateBox I a b) = ENNReal.ofReal (b - a) ^ I.card := by classical rw [fordCoordinateBox, Real.volume_Icc_pi] calc _ = ∏ i : Fin k, if i ∈ I then ENNReal.ofReal (b - a) else 1 := by apply prod_congr rfl intro i _ split_ifs <;> simp _ = _ := by rw [Fintype.prod_ite_mem, prod_const] def fordSameBinEvent {k : ℕ} (v : ℝ) (b : ℕ) (I : Finset (Fin k)) : Set (Fin k → ℝ) := Set.Icc (fun _ ↦ 0) (fun _ ↦ 1) ∩ {x | ∀ i ∈ I, ⌊v * x i⌋₊ = b} theorem fordSameBinEvent_measurable {k : ℕ} (v : ℝ) (b : ℕ) (I : Finset (Fin k)) : MeasurableSet (fordSameBinEvent v b I) := by apply measurableSet_Icc.inter simp only [Set.ofPred_forall] exact MeasurableSet.iInter fun i ↦ MeasurableSet.iInter fun _ ↦ measurableSet_eq_fun ((measurable_const.mul (measurable_pi_apply i)).nat_floor) measurable_const theorem fordSameBinEvent_volume_le {k v : ℕ} (hv : 0 < v) (b : ℕ) (I : Finset (Fin k)) : volume (fordSameBinEvent (v : ℝ) b I) ≤ (ENNReal.ofReal (1 / (v : ℝ))) ^ I.card := by have hvR : (0 : ℝ) < v := Nat.cast_pos.mpr hv have hsub : fordSameBinEvent (v : ℝ) b I ⊆ fordCoordinateBox I ((b : ℝ) / v) (((b : ℝ) + 1) / v) := by intro x hx constructor · intro i by_cases hi : i ∈ I · simp only [if_pos hi] apply (div_le_iff₀ hvR).mpr have hfloor := Nat.floor_le (mul_nonneg hvR.le (hx.1.1 i)) rw [hx.2 i hi] at hfloor simpa only [mul_comm] using hfloor · simpa only [if_neg hi] using hx.1.1 i · intro i by_cases hi : i ∈ I · simp only [if_pos hi] apply (le_div_iff₀ hvR).mpr have hfloor := (Nat.lt_floor_add_one ((v : ℝ) * x i)).le rw [hx.2 i hi] at hfloor simpa only [mul_comm] using hfloor · simpa only [if_neg hi] using hx.1.2 i calc _ ≤ volume (fordCoordinateBox I ((b : ℝ) / v) (((b : ℝ) + 1) / v)) := measure_mono hsub _ = _ := by rw [fordCoordinateBox_volume]; congr 2; ring theorem fordSameBinEvent_endpoint_null {k v : ℕ} (hv : 0 < v) (I : Finset (Fin k)) (hI : I.Nonempty) : volume (fordSameBinEvent (v : ℝ) v I) = 0 := by have hvR : (0 : ℝ) < v := Nat.cast_pos.mpr hv have hsub : fordSameBinEvent (v : ℝ) v I ⊆ fordCoordinateBox I 1 1 := by intro x hx constructor · intro i by_cases hi : i ∈ I · simp only [if_pos hi] have hfloor := Nat.floor_le (mul_nonneg hvR.le (hx.1.1 i)) rw [hx.2 i hi] at hfloor nlinarith · simpa only [if_neg hi] using hx.1.1 i · intro i simpa using hx.1.2 i apply measure_mono_null hsub rw [fordCoordinateBox_volume, sub_self, ENNReal.ofReal_zero, zero_pow (ne_of_gt hI.card_pos)] def fordOccupancyAtLeast (k : ℕ) (v : ℝ) (b R : ℕ) : Set (Fin k → ℝ) := Set.Icc (fun _ ↦ 0) (fun _ ↦ 1) ∩ {x | R ≤ fordBinOccupancy v x b} theorem fordOccupancyAtLeast_eq_union (k : ℕ) (v : ℝ) (b R : ℕ) : fordOccupancyAtLeast k v b R = ⋃ I ∈ (univ : Finset (Fin k)).powersetCard R, fordSameBinEvent v b I := by classical ext x constructor · intro hx obtain ⟨I, hI, hcard⟩ := exists_subset_card_eq hx.2 refine Set.mem_iUnion.mpr ⟨I, Set.mem_iUnion.mpr ⟨mem_powersetCard.mpr ⟨subset_univ I, hcard⟩, hx.1, ?_⟩⟩ intro i hi exact (mem_filter.mp (hI hi)).2 · intro hx obtain ⟨I, hI⟩ := Set.mem_iUnion.mp hx obtain ⟨hIR, hIx⟩ := Set.mem_iUnion.mp hI refine ⟨hIx.1, ?_⟩ rw [← (mem_powersetCard.mp hIR).2] exact card_le_card (fun i hi ↦ mem_filter.mpr ⟨mem_univ i, hIx.2 i hi⟩) theorem fordOccupancyAtLeast_measurable (k : ℕ) (v : ℝ) (b R : ℕ) : MeasurableSet (fordOccupancyAtLeast k v b R) := by rw [fordOccupancyAtLeast_eq_union] exact MeasurableSet.iUnion fun I ↦ MeasurableSet.iUnion fun _ ↦ fordSameBinEvent_measurable v b I theorem fordOccupancyAtLeast_volume_le {k v : ℕ} (hv : 0 < v) (b R : ℕ) : volume (fordOccupancyAtLeast k (v : ℝ) b R) ≤ (k.choose R : ℝ≥0∞) * (ENNReal.ofReal (1 / (v : ℝ))) ^ R := by classical rw [fordOccupancyAtLeast_eq_union] calc _ ≤ ∑ I ∈ (univ : Finset (Fin k)).powersetCard R, volume (fordSameBinEvent (v : ℝ) b I) := measure_biUnion_finset_le _ _ _ ≤ ∑ _I ∈ (univ : Finset (Fin k)).powersetCard R, ENNReal.ofReal (1 / (v : ℝ)) ^ R := by apply sum_le_sum intro I hI simpa only [(mem_powersetCard.mp hI).2] using fordSameBinEvent_volume_le hv b I _ = _ := by simp [nsmul_eq_mul] theorem fordOccupancyAtLeast_endpoint_null {k v R : ℕ} (hv : 0 < v) (hR : 0 < R) : volume (fordOccupancyAtLeast k (v : ℝ) v R) = 0 := by classical rw [fordOccupancyAtLeast_eq_union] apply measure_iUnion_null intro I apply measure_iUnion_null intro hI apply fordSameBinEvent_endpoint_null hv I apply card_pos.mp rw [(mem_powersetCard.mp hI).2] exact hR def fordCrowdedBins (k : ℕ) (v : ℝ) (R : ℕ) : Set (Fin k → ℝ) := Set.Icc (fun _ ↦ 0) (fun _ ↦ 1) ∩ {x | ∃ b : ℕ, R ≤ fordBinOccupancy v x b} theorem fordCrowdedBins_eq_union (k : ℕ) (v : ℝ) (R : ℕ) : fordCrowdedBins k v R = ⋃ b : ℕ, fordOccupancyAtLeast k v b R := by ext x constructor · rintro ⟨hx, b, hb⟩ exact Set.mem_iUnion.mpr ⟨b, hx, hb⟩ · intro hx obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hx exact ⟨hb.1, b, hb.2⟩ theorem fordCrowdedBins_measurable (k : ℕ) (v : ℝ) (R : ℕ) : MeasurableSet (fordCrowdedBins k v R) := by rw [fordCrowdedBins_eq_union] exact MeasurableSet.iUnion fun b ↦ fordOccupancyAtLeast_measurable k v b R theorem fordCrowdedBins_subset_finite_union {k v R : ℕ} (hR : 0 < R) : fordCrowdedBins k (v : ℝ) R ⊆ ⋃ b ∈ range (v + 1), fordOccupancyAtLeast k (v : ℝ) b R := by intro x hx obtain ⟨b, hb⟩ := hx.2 have hpos : 0 < fordBinOccupancy (v : ℝ) x b := lt_of_lt_of_le hR hb obtain ⟨i, hi⟩ := card_pos.mp hpos have hib := (mem_filter.mp hi).2 have hbound : (v : ℝ) * x i ≤ v := by simpa only [mul_one] using mul_le_mul_of_nonneg_left (hx.1.2 i) (Nat.cast_nonneg v) have hbv : b ≤ v := by simpa only [hib, Nat.floor_natCast] using Nat.floor_mono hbound exact Set.mem_iUnion.mpr ⟨b, Set.mem_iUnion.mpr ⟨mem_range.mpr (Nat.lt_succ_of_le hbv), hx.1, hb⟩⟩ /-- The endpoint bin has zero measure, so the union bound has exactly `v` bins. -/ theorem fordCrowdedBins_volume_le {k v R : ℕ} (hv : 0 < v) (hR : 0 < R) : volume (fordCrowdedBins k (v : ℝ) R) ≤ (v : ℝ≥0∞) * (k.choose R : ℝ≥0∞) * ENNReal.ofReal (1 / (v : ℝ)) ^ R := by calc _ ≤ volume (⋃ b ∈ range (v + 1), fordOccupancyAtLeast k (v : ℝ) b R) := measure_mono (fordCrowdedBins_subset_finite_union hR) _ ≤ ∑ b ∈ range (v + 1), volume (fordOccupancyAtLeast k (v : ℝ) b R) := measure_biUnion_finset_le _ _ _ = ∑ b ∈ range v, volume (fordOccupancyAtLeast k (v : ℝ) b R) := by rw [sum_range_succ, fordOccupancyAtLeast_endpoint_null hv hR, add_zero] _ ≤ ∑ _b ∈ range v, (k.choose R : ℝ≥0∞) * ENNReal.ofReal (1 / (v : ℝ)) ^ R := sum_le_sum fun b _ ↦ fordOccupancyAtLeast_volume_le hv b R _ = _ := by simp [nsmul_eq_mul, mul_assoc] theorem fordCrowdedBins_probability_le {k v R : ℕ} (hv : 0 < v) (hR : 0 < R) : (volume (fordCrowdedBins k (v : ℝ) R)).toReal ≤ (v : ℝ) * (k.choose R : ℝ) / (v : ℝ) ^ R := by have h := ENNReal.toReal_mono (by finiteness) (fordCrowdedBins_volume_le hv hR (k := k)) simp only [ENNReal.toReal_mul, ENNReal.toReal_natCast, ENNReal.toReal_pow] at h rw [ENNReal.toReal_ofReal (by positivity : (0 : ℝ) ≤ 1 / (v : ℝ))] at h simpa only [one_div, inv_pow, div_eq_mul_inv, one_mul] using h end Erdos859Verification end /- Inlined development module: FordSubsetIntegral.lean -/ section /- The real fixed-cardinality support sum is bounded by an actual cube integral. -/ open Finset Real MeasureTheory open scoped ENNReal namespace Erdos859Verification noncomputable def fordSubsetCubeIntegral (N n : ℕ) : ℝ := ∫ u in Set.Icc (fun _ : Fin n ↦ 0) (fun _ ↦ fordPrimeCumulativeOdds N), fordSubsetEnvelope u theorem fordSubsetEnvelope_integrable_cube (N n : ℕ) : IntegrableOn (fordSubsetEnvelope : (Fin n → ℝ) → ℝ) (Set.Icc (fun _ ↦ 0) (fun _ ↦ fordPrimeCumulativeOdds N)) := (fordSubsetEnvelope_continuous n).continuousOn.integrableOn_compact isCompact_Icc theorem fordSubsetCubeIntegral_nonneg (N n : ℕ) : 0 ≤ fordSubsetCubeIntegral N n := integral_nonneg (fun u ↦ fordSubsetEnvelope_nonneg u) theorem ford_prime_support_cardinality_integral {P : Finset ℕ} {N n : ℕ} (hP : ∀ p ∈ P, p.Prime) (hPN : ∀ p ∈ P, p ≤ N) {d : ℝ} (hd : 0 ≤ d) : (∑ S ∈ P.powerset.filter (fun S ↦ S.card = n), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) ≤ ((d + fordPrimeCoordinateConstant) * (2 : ℝ) ^ n / (n.factorial : ℝ)) * fordSubsetCubeIntegral N n := by classical let K : ℝ := (d + fordPrimeCoordinateConstant) * (2 : ℝ) ^ n have hK : 0 ≤ K := by have := fordPrimeCoordinateConstant_pos dsimp [K] positivity have hfac : (0 : ℝ) < n.factorial := by exact_mod_cast Nat.factorial_pos n have hleft : ENNReal.ofReal ((n.factorial : ℝ) * (∑ S ∈ P.powerset.filter (fun S ↦ S.card = n), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d))) = ∑ x ∈ univ.filter (Function.Injective : (Fin n → P) → Prop), (∏ i, ENNReal.ofReal (fordPrimeOdds (x i).val)) * ENNReal.ofReal (volume.real (primeSubsetSumSupport (tupleSupport x) d)) := by rw [← sum_injective_tuple_product P n fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d))] rw [ENNReal.ofReal_sum_of_nonneg (fun x _ ↦ mul_nonneg (prod_nonneg fun i _ ↦ fordPrimeOdds_nonneg (x i).val) measureReal_nonneg)] apply sum_congr rfl intro x _ rw [ENNReal.ofReal_mul (prod_nonneg fun i _ ↦ fordPrimeOdds_nonneg (x i).val), ENNReal.ofReal_prod_of_nonneg (fun i _ ↦ fordPrimeOdds_nonneg (x i).val)] have hright : ENNReal.ofReal (K * fordSubsetCubeIntegral N n) = ∫⁻ u in Set.Icc (fun _ : Fin n ↦ 0) (fun _ ↦ fordPrimeCumulativeOdds N), ENNReal.ofReal (K * fordSubsetEnvelope u) := by unfold fordSubsetCubeIntegral rw [← integral_const_mul] exact ofReal_integral_eq_lintegral_ofReal ((fordSubsetEnvelope_integrable_cube N n).const_mul K) (Filter.Eventually.of_forall (fun u ↦ mul_nonneg hK (fordSubsetEnvelope_nonneg u))) have hmain := ford_prime_support_tuple_integral (n := n) hP hPN hd rw [← hleft, ← hright] at hmain have hreal := (ENNReal.ofReal_le_ofReal_iff (mul_nonneg hK (fordSubsetCubeIntegral_nonneg N n))).mp hmain change _ ≤ (K / (n.factorial : ℝ)) * fordSubsetCubeIntegral N n rw [div_mul_eq_mul_div] apply (le_div_iff₀ hfac).mpr nlinarith only [hreal] end Erdos859Verification end /- Inlined development module: FordCubeScaling.lean -/ section /- Scaling the cumulative-prime cube to the unit cube. -/ open Finset Real MeasureTheory open scoped Pointwise namespace Erdos859Verification theorem ford_positive_smul_unit_cube (n : ℕ) {L : ℝ} (hL : 0 < L) : L • Set.Icc (fun _ : Fin n ↦ (0 : ℝ)) (fun _ ↦ 1) = Set.Icc (fun _ : Fin n ↦ (0 : ℝ)) (fun _ ↦ L) := by ext x constructor · rintro ⟨y, hy, rfl⟩ refine ⟨fun i ↦ mul_nonneg hL.le (hy.1 i), fun i ↦ ?_⟩ change L * y i ≤ L nlinarith [hy.2 i] · intro hx refine ⟨fun i ↦ x i / L, ⟨fun i ↦ div_nonneg (hx.1 i) hL.le, fun i ↦ (div_le_one hL).mpr (hx.2 i)⟩, ?_⟩ funext i change L * (x i / L) = x i field_simp theorem ford_cube_integral_scale (n : ℕ) (f : (Fin n → ℝ) → ℝ) {L : ℝ} (hL : 0 < L) : (∫ u in Set.Icc (fun _ : Fin n ↦ 0) (fun _ ↦ L), f u) = L ^ n * ∫ x in Set.Icc (fun _ : Fin n ↦ 0) (fun _ ↦ 1), f (fun i ↦ L * x i) := by have h := Measure.setIntegral_comp_smul_of_pos volume f (Set.Icc (fun _ : Fin n ↦ (0 : ℝ)) (fun _ ↦ 1)) hL have hfin : Module.finrank ℝ (Fin n → ℝ) = n := by simp rw [hfin, ford_positive_smul_unit_cube n hL] at h simp only [smul_eq_mul] at h have hLn : L ^ n ≠ 0 := pow_ne_zero _ hL.ne' calc _ = L ^ n * ((L ^ n)⁻¹ * ∫ u in Set.Icc (fun _ : Fin n ↦ 0) (fun _ ↦ L), f u) := by field_simp _ = _ := congrArg (fun z : ℝ ↦ L ^ n * z) h.symm noncomputable def fordUnitEnvelopeMoment (n : ℕ) (v : ℝ) : ℝ := ∫ x in Set.Icc (fun _ : Fin n ↦ 0) (fun _ ↦ 1), fordSubsetEnvelope (fun i ↦ log 2 * v * x i) theorem ford_prime_support_unit_integral {P : Finset ℕ} {N n : ℕ} (hP : ∀ p ∈ P, p.Prime) (hPN : ∀ p ∈ P, p ≤ N) {d v : ℝ} (hd : 0 ≤ d) (hv : 0 < v) (hM : fordPrimeCumulativeOdds N ≤ log 2 * v) : (∑ S ∈ P.powerset.filter (fun S ↦ S.card = n), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) ≤ ((d + fordPrimeCoordinateConstant) * (2 * log 2 * v) ^ n / (n.factorial : ℝ)) * fordUnitEnvelopeMoment n v := by have hL : 0 < log 2 * v := mul_pos (log_pos (by norm_num)) hv have hcoef : 0 ≤ (d + fordPrimeCoordinateConstant) * (2 : ℝ) ^ n / (n.factorial : ℝ) := by have := fordPrimeCoordinateConstant_pos positivity have hmono : fordSubsetCubeIntegral N n ≤ ∫ u in Set.Icc (fun _ : Fin n ↦ 0) (fun _ ↦ log 2 * v), fordSubsetEnvelope u := by apply setIntegral_mono_set ((fordSubsetEnvelope_continuous n).continuousOn.integrableOn_compact isCompact_Icc) (Filter.Eventually.of_forall (fun u ↦ fordSubsetEnvelope_nonneg u)) exact Filter.Eventually.of_forall (fun _ hu ↦ ⟨hu.1, fun i ↦ (hu.2 i).trans hM⟩) calc _ ≤ ((d + fordPrimeCoordinateConstant) * (2 : ℝ) ^ n / (n.factorial : ℝ)) * fordSubsetCubeIntegral N n := ford_prime_support_cardinality_integral hP hPN hd _ ≤ ((d + fordPrimeCoordinateConstant) * (2 : ℝ) ^ n / (n.factorial : ℝ)) * (∫ u in Set.Icc (fun _ : Fin n ↦ 0) (fun _ ↦ log 2 * v), fordSubsetEnvelope u) := mul_le_mul_of_nonneg_left hmono hcoef _ = _ := by rw [ford_cube_integral_scale n fordSubsetEnvelope hL] unfold fordUnitEnvelopeMoment simp only [mul_pow] ring end Erdos859Verification end /- Inlined development module: FordCumulativeMertens.lean -/ section /- Bounded-shift comparison between the actual cumulative odds and log log N. -/ open Finset Real Filter namespace Erdos859Verification theorem fordPrimeCumulativeOdds_correction (N : ℕ) : 0 ≤ fordPrimeCumulativeOdds N - primeReciprocalSum (N : ℝ) ∧ fordPrimeCumulativeOdds N - primeReciprocalSum (N : ℝ) ≤ 1 := by have hid : fordPrimeCumulativeOdds N - primeReciprocalSum (N : ℝ) = ∑ p ∈ (Ioc 0 N).filter Nat.Prime, 1 / ((p : ℝ) * ((p : ℝ) - 1)) := by unfold fordPrimeCumulativeOdds primeReciprocalSum rw [Nat.floor_natCast, ← sum_sub_distrib] apply sum_congr rfl intro p hp have hprime := (mem_filter.mp hp).2 have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hprime.two_le rw [fordPrimeOdds_eq hprime] field_simp [(by linarith : (p : ℝ) - 1 ≠ 0), (by linarith : (p : ℝ) ≠ 0)] ring rw [hid] constructor · apply sum_nonneg intro p hp have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast (mem_filter.mp hp).2.two_le exact one_div_nonneg.mpr (mul_nonneg (Nat.cast_nonneg _) (by linarith)) · have hkernel : (∑ p ∈ Ioc 1 N, 1 / ((p : ℝ) * ((p : ℝ) - 1))) ≤ 1 := by simpa only [Nat.cast_one, one_div_one] using sum_Ioc_reciprocal_kernel_le (N := 1) (M := N) (by omega) apply le_trans _ hkernel apply sum_le_sum_of_subset_of_nonneg · intro p hp exact mem_Ioc.mpr ⟨(mem_filter.mp hp).2.one_lt, (mem_Ioc.mp (mem_filter.mp hp).1).2⟩ · intro p hp _ have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast (by have := (mem_Ioc.mp hp).1; omega : 2 ≤ p) exact one_div_nonneg.mpr (mul_nonneg (Nat.cast_nonneg _) (by linarith)) noncomputable def fordCumulativeShiftConstant : ℝ := |PrimeMertens.M| + mertensErrorConstant / log 2 + 1 theorem fordCumulativeShiftConstant_pos : 0 < fordCumulativeShiftConstant := by have := mertensErrorConstant_pos have : 0 < log (2 : ℝ) := log_pos (by norm_num) unfold fordCumulativeShiftConstant positivity theorem fordPrimeCumulativeOdds_loglog {N : ℕ} (hN : 2 ≤ N) : |fordPrimeCumulativeOdds N - log (log (N : ℝ))| ≤ fordCumulativeShiftConstant := by have hNr : (2 : ℝ) ≤ N := by exact_mod_cast hN have hc := fordPrimeCumulativeOdds_correction N have hm := primeReciprocalSum_estimate hNr have herr : mertensErrorConstant / log (N : ℝ) ≤ mertensErrorConstant / log 2 := div_le_div_of_nonneg_left mertensErrorConstant_pos.le (log_pos (by norm_num)) (log_le_log (by norm_num) hNr) apply abs_le.mpr have hm' := abs_le.mp hm have hM := abs_le.mp (le_refl |PrimeMertens.M|) unfold fordCumulativeShiftConstant constructor <;> linarith noncomputable def fordPrimeCubeScale (N : ℕ) : ℕ := ⌈fordPrimeCumulativeOdds N / log 2⌉₊ theorem fordPrimeCubeScale_covers (N : ℕ) : fordPrimeCumulativeOdds N ≤ log 2 * fordPrimeCubeScale N := by have h := Nat.le_ceil (fordPrimeCumulativeOdds N / log 2) have hl : 0 < log (2 : ℝ) := log_pos (by norm_num) exact (div_le_iff₀ hl).mp h |>.trans_eq (mul_comm _ _) theorem fordPrimeCubeScale_rounding (N : ℕ) : log 2 * fordPrimeCubeScale N < fordPrimeCumulativeOdds N + log 2 := by have hl : 0 < log (2 : ℝ) := log_pos (by norm_num) have h := Nat.ceil_lt_add_one (div_nonneg (fordPrimeCumulativeOdds_nonneg N) hl.le) have h' := mul_lt_mul_of_pos_left h hl dsimp only [fordPrimeCubeScale] calc _ < log 2 * (fordPrimeCumulativeOdds N / log 2 + 1) := h' _ = _ := by field_simp theorem fordPrimeCubeScale_pos {N : ℕ} (hN : 2 ≤ N) : 0 < fordPrimeCubeScale N := by have htwo : fordPrimeCumulativeOdds 2 = 1 := by have hset : ((Ioc 0 2).filter Nat.Prime) = {2} := by decide simp only [fordPrimeCumulativeOdds, hset, sum_singleton] norm_num [fordPrimeOdds] have hM : 0 < fordPrimeCumulativeOdds N := by have h := fordPrimeCumulativeOdds_mono hN rw [htwo] at h linarith exact Nat.ceil_pos.mpr (div_pos hM (log_pos (by norm_num))) theorem fordPrimeCubeScale_loglog {N : ℕ} (hN : 2 ≤ N) : |log 2 * fordPrimeCubeScale N - log (log (N : ℝ))| ≤ fordCumulativeShiftConstant + log 2 := by have hm := abs_le.mp (fordPrimeCumulativeOdds_loglog hN) have hlow := fordPrimeCubeScale_covers N have hupp := fordPrimeCubeScale_rounding N have hl : 0 < log (2 : ℝ) := log_pos (by norm_num) exact abs_le.mpr ⟨by linarith, by linarith⟩ end Erdos859Verification end /- Inlined development module: FordCardinalitySeries.lean -/ section /- Geometric summation of the factorial profile about its critical cardinality. -/ open Finset Real namespace Erdos859Verification noncomputable def fordFactorialCoefficient (v k : ℕ) : ℝ := (2 * log 2 * v) ^ k / ((k + 1).factorial : ℝ) theorem fordFactorialCoefficient_nonneg (v k : ℕ) : 0 ≤ fordFactorialCoefficient v k := by unfold fordFactorialCoefficient have : 0 < log (2 : ℝ) := log_pos (by norm_num) positivity theorem fordFactorialCoefficient_step (v k : ℕ) : ((k : ℝ) + 2) * fordFactorialCoefficient v (k + 1) = (2 * log 2 * v) * fordFactorialCoefficient v k := by unfold fordFactorialCoefficient rw [show k + 1 + 1 = (k + 1) + 1 by omega, Nat.factorial_succ] push_cast rw [pow_succ] field_simp ring theorem fordFactorialCoefficient_below_step {v k : ℕ} (hv : 10 ≤ v) (hk : k < v) : fordFactorialCoefficient v k ≤ (4 / 5 : ℝ) * fordFactorialCoefficient v (k + 1) := by have hvr : (10 : ℝ) ≤ v := by exact_mod_cast hv have hkr : (k : ℝ) + 2 ≤ (v : ℝ) + 1 := by exact_mod_cast (by omega : k + 2 ≤ v + 1) have hl := log_two_gt_d9 have hX : 0 < 2 * log 2 * v := by positivity have hcoef : (k : ℝ) + 2 ≤ (4 / 5 : ℝ) * (2 * log 2 * v) := by nlinarith have hm := mul_le_mul_of_nonneg_right hcoef (fordFactorialCoefficient_nonneg v (k + 1)) rw [fordFactorialCoefficient_step] at hm nlinarith theorem fordFactorialCoefficient_below {v k : ℕ} (hv : 10 ≤ v) (hk : k ≤ v) : fordFactorialCoefficient v k ≤ (4 / 5 : ℝ) ^ (v - k) * fordFactorialCoefficient v v := by suffices h : ∀ j k : ℕ, k + j = v → fordFactorialCoefficient v k ≤ (4 / 5 : ℝ) ^ j * fordFactorialCoefficient v v by exact h (v - k) k (by omega) intro j induction j with | zero => intro k h; simp [show k = v by omega] | succ j ih => intro k h have hstep := fordFactorialCoefficient_below_step hv (by omega : k < v) have hnext := ih (k + 1) (by omega) calc _ ≤ (4 / 5 : ℝ) * fordFactorialCoefficient v (k + 1) := hstep _ ≤ (4 / 5 : ℝ) * ((4 / 5 : ℝ) ^ j * fordFactorialCoefficient v v) := mul_le_mul_of_nonneg_left hnext (by norm_num) _ = _ := by rw [pow_succ]; ring theorem fordFactorialCoefficient_above (v j : ℕ) : fordFactorialCoefficient v (v + j) ≤ (2 * (4 / 5 : ℝ)) ^ j * fordFactorialCoefficient v v := by induction j with | zero => simp | succ j ih => have hs := fordFactorialCoefficient_step v (v + j) have hnon := fordFactorialCoefficient_nonneg v (v + j) have hl := log_two_lt_d9 have hvr := Nat.cast_nonneg (α := ℝ) v have hjr := Nat.cast_nonneg (α := ℝ) j have hX : 2 * log 2 * v ≤ (2 * (4 / 5 : ℝ)) * ((v + j : ℕ) + 2) := by push_cast nlinarith have hm := mul_le_mul_of_nonneg_right hX hnon have hden : 0 < ((v + j : ℕ) : ℝ) + 2 := by positivity have hstep : fordFactorialCoefficient v (v + (j + 1)) ≤ (2 * (4 / 5 : ℝ)) * fordFactorialCoefficient v (v + j) := by rw [show v + (j + 1) = v + j + 1 by omega] nlinarith calc _ ≤ (2 * (4 / 5 : ℝ)) * fordFactorialCoefficient v (v + j) := hstep _ ≤ (2 * (4 / 5 : ℝ)) * ((2 * (4 / 5 : ℝ)) ^ j * fordFactorialCoefficient v v) := mul_le_mul_of_nonneg_left ih (by norm_num) _ = _ := by rw [pow_succ]; ring noncomputable def fordCardinalityProfile (v k : ℕ) : ℝ := fordFactorialCoefficient v k * (1 + ((k : ℝ) - v) ^ 2) / (1 + exp (log 2 * ((k : ℝ) - v))) noncomputable def fordGeometricQuadratic (j : ℕ) : ℝ := (4 / 5 : ℝ) ^ j * (1 + (j : ℝ) ^ 2) theorem fordCardinalityProfile_below {v k : ℕ} (hv : 10 ≤ v) (hk : k ≤ v) : fordCardinalityProfile v k ≤ fordFactorialCoefficient v v * fordGeometricQuadratic (v - k) := by have hn : 0 ≤ fordFactorialCoefficient v k * (1 + ((k : ℝ) - v) ^ 2) := by exact mul_nonneg (fordFactorialCoefficient_nonneg v k) (by positivity) have hden : 1 ≤ 1 + exp (log 2 * ((k : ℝ) - v)) := by linarith [exp_pos (log 2 * ((k : ℝ) - v))] calc _ ≤ fordFactorialCoefficient v k * (1 + ((k : ℝ) - v) ^ 2) := div_le_self hn hden _ ≤ ((4 / 5 : ℝ) ^ (v - k) * fordFactorialCoefficient v v) * (1 + ((k : ℝ) - v) ^ 2) := mul_le_mul_of_nonneg_right (fordFactorialCoefficient_below hv hk) (by positivity) _ = _ := by unfold fordGeometricQuadratic; rw [Nat.cast_sub hk]; ring theorem fordCardinalityProfile_above (v j : ℕ) : fordCardinalityProfile v (v + j) ≤ fordFactorialCoefficient v v * fordGeometricQuadratic j := by have he : exp (log 2 * (((v + j : ℕ) : ℝ) - v)) = (2 : ℝ) ^ j := by push_cast rw [add_sub_cancel_left, mul_comm, exp_nat_mul, exp_log (by norm_num : (0 : ℝ) < 2)] have hp : 0 < (2 : ℝ) ^ j := by positivity unfold fordCardinalityProfile rw [he] apply (div_le_iff₀ (by positivity : 0 < 1 + (2 : ℝ) ^ j)).mpr have hm := mul_le_mul_of_nonneg_right (fordFactorialCoefficient_above v j) (by positivity : 0 ≤ 1 + (j : ℝ) ^ 2) have hnon : 0 ≤ fordFactorialCoefficient v v * fordGeometricQuadratic j := by unfold fordGeometricQuadratic exact mul_nonneg (fordFactorialCoefficient_nonneg v v) (by positivity) simp only [Nat.cast_add, add_sub_cancel_left] calc _ ≤ ((2 * (4 / 5 : ℝ)) ^ j * fordFactorialCoefficient v v) * (1 + (j : ℝ) ^ 2) := hm _ = (fordFactorialCoefficient v v * fordGeometricQuadratic j) * (2 : ℝ) ^ j := by unfold fordGeometricQuadratic rw [mul_pow] ring _ ≤ _ := by nlinarith theorem fordGeometricQuadratic_sum_bound (s : Finset ℕ) : (∑ j ∈ s, fordGeometricQuadratic j) ≤ 250 := by have hs := hasSum_choose_mul_geometric_of_norm_lt_one (𝕜 := ℝ) 2 (by norm_num : ‖(4 / 5 : ℝ)‖ < 1) have hsum : (∑' j : ℕ, ((j + 2).choose 2 : ℝ) * (4 / 5 : ℝ) ^ j) = 125 := by calc _ = 1 / (1 - (4 / 5 : ℝ)) ^ (2 + 1) := hs.tsum_eq _ = 125 := by norm_num have hpoint (j : ℕ) : fordGeometricQuadratic j ≤ 2 * (((j + 2).choose 2 : ℝ) * (4 / 5 : ℝ) ^ j) := by have h := Nat.descFactorial_eq_factorial_mul_choose (j + 2) 2 norm_num [Nat.descFactorial_succ, show j + 2 - 1 = j + 1 by omega] at h have hc : ((j : ℝ) + 2) * ((j : ℝ) + 1) = 2 * ((j + 2).choose 2 : ℝ) := by rw [mul_comm] exact_mod_cast h have hpoly : 1 + (j : ℝ) ^ 2 ≤ 2 * ((j + 2).choose 2 : ℝ) := by nlinarith [Nat.cast_nonneg (α := ℝ) j] have hm := mul_le_mul_of_nonneg_left hpoly (by positivity : 0 ≤ (4 / 5 : ℝ) ^ j) unfold fordGeometricQuadratic nlinarith calc _ ≤ ∑ j ∈ s, 2 * (((j + 2).choose 2 : ℝ) * (4 / 5 : ℝ) ^ j) := sum_le_sum fun j _ ↦ hpoint j _ = 2 * ∑ j ∈ s, ((j + 2).choose 2 : ℝ) * (4 / 5 : ℝ) ^ j := by rw [mul_sum] _ ≤ 2 * ∑' j : ℕ, ((j + 2).choose 2 : ℝ) * (4 / 5 : ℝ) ^ j := mul_le_mul_of_nonneg_left (hs.summable.sum_le_tsum s (fun j _ ↦ by positivity)) (by norm_num) _ = 250 := by rw [hsum]; norm_num theorem fordCardinalityProfile_sum_bound {v : ℕ} (hv : 10 ≤ v) (s : Finset ℕ) : (∑ k ∈ s, fordCardinalityProfile v k) ≤ 500 * fordFactorialCoefficient v v := by have hb : (∑ k ∈ s.filter (fun k ↦ k ≤ v), fordGeometricQuadratic (v - k)) ≤ 250 := by rw [← sum_image] · exact fordGeometricQuadratic_sum_bound _ · intro a ha b hb hab have := (mem_filter.mp ha).2 have := (mem_filter.mp hb).2 omega have ha : (∑ k ∈ s.filter (fun k ↦ ¬ k ≤ v), fordGeometricQuadratic (k - v)) ≤ 250 := by rw [← sum_image] · exact fordGeometricQuadratic_sum_bound _ · intro a ha b hb hab dsimp only at hab have := (mem_filter.mp ha).2 have := (mem_filter.mp hb).2 omega have hbelow : (∑ k ∈ s.filter (fun k ↦ k ≤ v), fordCardinalityProfile v k) ≤ fordFactorialCoefficient v v * 250 := by calc _ ≤ ∑ k ∈ s.filter (fun k ↦ k ≤ v), fordFactorialCoefficient v v * fordGeometricQuadratic (v - k) := sum_le_sum fun k hk ↦ fordCardinalityProfile_below hv (mem_filter.mp hk).2 _ = _ := by rw [← mul_sum] _ ≤ _ := mul_le_mul_of_nonneg_left hb (fordFactorialCoefficient_nonneg v v) have habove : (∑ k ∈ s.filter (fun k ↦ ¬ k ≤ v), fordCardinalityProfile v k) ≤ fordFactorialCoefficient v v * 250 := by calc _ ≤ ∑ k ∈ s.filter (fun k ↦ ¬ k ≤ v), fordFactorialCoefficient v v * fordGeometricQuadratic (k - v) := by apply sum_le_sum intro k hk have hvk : v ≤ k := by have := (mem_filter.mp hk).2; omega simpa only [Nat.add_sub_of_le hvk] using fordCardinalityProfile_above v (k - v) _ = _ := by rw [← mul_sum] _ ≤ _ := mul_le_mul_of_nonneg_left ha (fordFactorialCoefficient_nonneg v v) have hid := sum_filter_add_sum_filter_not s (fun k ↦ k ≤ v) (fordCardinalityProfile v) linarith end Erdos859Verification end /- Inlined development module: FordEnvelopeMoment.lean -/ section /- An actual cube integral bound from occupancy and the sorted deficit. -/ open Finset Real MeasureTheory open scoped ENNReal namespace Erdos859Verification theorem fordUnitEnvelope_integrable (k : ℕ) (v : ℝ) : IntegrableOn (fun x : Fin k → ℝ ↦ fordSubsetEnvelope (fun i ↦ log 2 * v * x i)) (Set.Icc (fun _ ↦ 0) (fun _ ↦ 1)) := by have hc : Continuous (fun x : Fin k → ℝ ↦ fordSubsetEnvelope (fun i ↦ log 2 * v * x i)) := (fordSubsetEnvelope_continuous k).comp (by fun_prop) exact hc.continuousOn.integrableOn_compact isCompact_Icc theorem fordUnitEnvelopeMoment_nonneg (k : ℕ) (v : ℝ) : 0 ≤ fordUnitEnvelopeMoment k v := integral_nonneg (fun _ ↦ fordSubsetEnvelope_nonneg _) theorem fordUnitEnvelopeMoment_le_one (k : ℕ) (v : ℝ) : fordUnitEnvelopeMoment k v ≤ 1 := by have hfinite : volume (Set.Icc (fun _ : Fin k ↦ (0 : ℝ)) (fun _ ↦ 1)) ≠ ∞ := by rw [ford_unitCube_volume] exact ENNReal.one_ne_top calc _ ≤ ∫ _x : Fin k → ℝ in Set.Icc (fun _ ↦ 0) (fun _ ↦ 1), (1 : ℝ) := integral_mono (fordUnitEnvelope_integrable k v) (integrableOn_const hfinite) (fun _ ↦ fordSubsetEnvelope_le_one _) _ = 1 := by rw [setIntegral_const, measureReal_def, ford_unitCube_volume]; simp theorem fordUnitEnvelopeMoment_split_bound {k R : ℕ} {v : ℝ} (hv : 0 ≤ v) : fordUnitEnvelopeMoment k v ≤ (4 * (R : ℝ) + 1) * fordDeficitMoment k v + min 1 (((k : ℝ) + 1) * exp (log 2 * (v - k))) * (volume (fordCrowdedBins k v R)).toReal := by classical let S : Set (Fin k → ℝ) := Set.Icc (fun _ ↦ 0) (fun _ ↦ 1) let B := fordCrowdedBins k v R let E := min 1 (((k : ℝ) + 1) * exp (log 2 * (v - k))) let C : ℝ := 4 * R + 1 have hE : 0 ≤ E := le_min (by norm_num) (by positivity) have hC : 0 ≤ C := by dsimp [C]; positivity have hB : MeasurableSet B := fordCrowdedBins_measurable k v R have hBS : B ⊆ S := fun _ hx ↦ hx.1 have hfinite : volume S ≠ ∞ := by change volume (Set.Icc (fun _ : Fin k ↦ (0 : ℝ)) (fun _ ↦ 1)) ≠ ∞ rw [ford_unitCube_volume] exact ENNReal.one_ne_top have hgi : IntegrableOn (fun x : Fin k → ℝ ↦ C * exp (log 2 * fordCubeDeficit v x)) S := (fordDeficit_exp_integrable k v).const_mul C have hbi : IntegrableOn (B.indicator (fun _ ↦ E)) S := (integrableOn_const (C := E) hfinite).indicator hB have hpoint : ∀ x ∈ S, fordSubsetEnvelope (fun i ↦ log 2 * v * x i) ≤ C * exp (log 2 * fordCubeDeficit v x) + B.indicator (fun _ ↦ E) x := by intro x hx by_cases hxB : x ∈ B · rw [Set.indicator_of_mem hxB] have hf := fordSubsetEnvelope_le_endpoint hv x hx.2 simp only [← mul_assoc] at hf exact hf.trans (le_add_of_nonneg_left (mul_nonneg hC (exp_pos _).le)) · rw [Set.indicator_of_notMem hxB, add_zero] have hocc : ∀ b : ℕ, (fordBinOccupancy v x b : ℝ) ≤ R := by intro b have hlt : fordBinOccupancy v x b < R := by apply lt_of_not_ge intro hb exact hxB ⟨hx, b, hb⟩ exact_mod_cast hlt.le simpa only [← mul_assoc] using fordSubsetEnvelope_le_deficit hv (Nat.cast_nonneg R) x hx.1 hocc calc _ ≤ ∫ x in S, C * exp (log 2 * fordCubeDeficit v x) + B.indicator (fun _ ↦ E) x := by apply integral_mono_ae (fordUnitEnvelope_integrable k v) (hgi.add hbi) filter_upwards [ae_restrict_mem measurableSet_Icc] with x hx exact hpoint x hx _ = C * fordDeficitMoment k v + E * (volume B).toReal := by rw [integral_add hgi hbi, integral_const_mul, setIntegral_indicator hB, Set.inter_eq_right.mpr hBS, setIntegral_const, smul_eq_mul, measureReal_def] change C * fordDeficitMoment k v + (volume B).toReal * E = _ ring _ = _ := rfl /-- Actual envelope expectation, retaining the exact binomial exceptional term. -/ theorem fordUnitEnvelopeMoment_occupancy_bound {k v R : ℕ} (hv : 0 < v) (hR : 0 < R) : fordUnitEnvelopeMoment k (v : ℝ) ≤ (4 * (R : ℝ) + 1) * fordDeficitMoment k (v : ℝ) + min 1 (((k : ℝ) + 1) * exp (log 2 * ((v : ℝ) - k))) * ((v : ℝ) * (k.choose R : ℝ) / (v : ℝ) ^ R) := by apply (fordUnitEnvelopeMoment_split_bound (k := k) (R := R) (Nat.cast_nonneg v)).trans exact add_le_add le_rfl (mul_le_mul_of_nonneg_left (fordCrowdedBins_probability_le (k := k) hv hR) (show 0 ≤ min 1 (((k : ℝ) + 1) * exp (log 2 * ((v : ℝ) - k))) from le_min (by norm_num) (by positivity))) /-- A fully explicit finite bound with no assumed tail or occupancy probabilities. -/ theorem fordUnitEnvelopeMoment_explicit_bound {k v R : ℕ} (hk : 0 < k) (hv : 0 < v) (hR : 0 < R) : fordUnitEnvelopeMoment k (v : ℝ) ≤ (4 * (R : ℝ) + 1) * (27648 * (1 + ((k : ℝ) - v) ^ 2) / ((k : ℝ) * (1 + (2 : ℝ) ^ ((k : ℝ) - v)))) + min 1 (((k : ℝ) + 1) * exp (log 2 * ((v : ℝ) - k))) * ((v : ℝ) * (k.choose R : ℝ) / (v : ℝ) ^ R) := by apply (fordUnitEnvelopeMoment_occupancy_bound (k := k) hv hR).trans exact add_le_add (mul_le_mul_of_nonneg_left (fordDeficitMoment_bound hk (Nat.cast_nonneg v)) (show (0 : ℝ) ≤ 4 * R + 1 by positivity)) le_rfl end Erdos859Verification end /- Inlined development module: FordEnvelopePowerSaving.lean -/ section /- A power saving for the actual envelope moment in the central cardinality range. -/ open Finset Real MeasureTheory Filter open scoped Topology namespace Erdos859Verification noncomputable def fordOccupancyCutoff (v : ℕ) : ℕ := ⌈(v : ℝ) ^ (1 / 4 : ℝ)⌉₊ theorem ford_binomial_occupancy_exponential {k v : ℕ} (hv : 0 < v) (hkv : k ≤ 10 * v) (R : ℕ) : (v : ℝ) * (k.choose R : ℝ) / (v : ℝ) ^ R ≤ (v : ℝ) * exp 20 * exp (-log 2 * (R : ℝ)) := by have hvR : (0 : ℝ) < v := Nat.cast_pos.mpr hv have hkvR : (k : ℝ) / v ≤ 10 := (div_le_iff₀ hvR).mpr (by exact_mod_cast hkv) have hfac : (0 : ℝ) < R.factorial := Nat.cast_pos.mpr (Nat.factorial_pos R) have hbound : (k.choose R : ℝ) / (v : ℝ) ^ R ≤ (10 : ℝ) ^ R / R.factorial := by calc _ ≤ ((k : ℝ) ^ R / R.factorial) / (v : ℝ) ^ R := div_le_div_of_nonneg_right (Nat.choose_le_pow_div R k) (by positivity) _ = ((k : ℝ) / v) ^ R / R.factorial := by rw [div_pow]; ring _ ≤ _ := div_le_div_of_nonneg_right (pow_le_pow_left₀ (by positivity) hkvR R) hfac.le have hexp : (10 : ℝ) ^ R / R.factorial ≤ exp 20 / (2 : ℝ) ^ R := by apply (le_div_iff₀ (by positivity : (0 : ℝ) < 2 ^ R)).mpr calc _ = (20 : ℝ) ^ R / R.factorial := by rw [div_mul_eq_mul_div, ← mul_pow]; norm_num _ ≤ _ := pow_div_factorial_le_exp 20 (by norm_num) R have hpow : 1 / (2 : ℝ) ^ R = exp (-log 2 * (R : ℝ)) := by rw [show -log 2 * (R : ℝ) = -(log 2 * (R : ℝ)) by ring, exp_neg, ford_exp_log_two_nat, one_div] calc _ = (v : ℝ) * ((k.choose R : ℝ) / (v : ℝ) ^ R) := by ring _ ≤ (v : ℝ) * (exp 20 / (2 : ℝ) ^ R) := mul_le_mul_of_nonneg_left (hbound.trans hexp) hvR.le _ = _ := by rw [div_eq_mul_one_div, hpow]; ring theorem fordOccupancyCutoff_bounds {v : ℕ} (hv : 0 < v) : 0 < fordOccupancyCutoff v ∧ (fordOccupancyCutoff v : ℝ) ≤ 2 * (v : ℝ) ^ (1 / 4 : ℝ) := by have hv1 : (1 : ℝ) ≤ v := by exact_mod_cast hv have ht : 1 ≤ (v : ℝ) ^ (1 / 4 : ℝ) := one_le_rpow hv1 (by norm_num) have hlo : (v : ℝ) ^ (1 / 4 : ℝ) ≤ (fordOccupancyCutoff v : ℝ) := Nat.le_ceil _ have hhi : (fordOccupancyCutoff v : ℝ) < (v : ℝ) ^ (1 / 4 : ℝ) + 1 := Nat.ceil_lt_add_one (by positivity) constructor · exact_mod_cast (show (0 : ℝ) < fordOccupancyCutoff v by linarith) · linarith theorem ford_occupancy_tail_tendsto : Tendsto (fun v : ℕ ↦ (v : ℝ) ^ 4 * exp 20 * exp (-log 2 * (v : ℝ) ^ (1 / 4 : ℝ))) atTop (𝓝 0) := by have ht : Tendsto (fun v : ℕ ↦ (v : ℝ) ^ (1 / 4 : ℝ)) atTop atTop := (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 4)).comp (tendsto_natCast_atTop_atTop (R := ℝ)) have h := ((tendsto_rpow_mul_exp_neg_mul_atTop_nhds_zero 16 (log 2) (log_pos (by norm_num))).comp ht).const_mul (exp 20) have heq (v : ℕ) : ((v : ℝ) ^ (1 / 4 : ℝ)) ^ (16 : ℝ) = (v : ℝ) ^ 4 := by rw [← rpow_mul (Nat.cast_nonneg v)] norm_num simpa only [Function.comp_def, heq, mul_zero, mul_left_comm, mul_assoc] using h theorem ford_binomial_occupancy_eventually_small : ∀ᶠ v : ℕ in atTop, ∀ k : ℕ, k ≤ 10 * v → (v : ℝ) * (k.choose (fordOccupancyCutoff v) : ℝ) / (v : ℝ) ^ fordOccupancyCutoff v ≤ 1 / (v : ℝ) ^ 3 := by filter_upwards [ford_occupancy_tail_tendsto.eventually_lt_const (by norm_num : (0 : ℝ) < 1), eventually_gt_atTop 0] with v hsmall hv intro k hkv have hvR : (0 : ℝ) < v := Nat.cast_pos.mpr hv have hceil : (v : ℝ) ^ (1 / 4 : ℝ) ≤ (fordOccupancyCutoff v : ℝ) := Nat.le_ceil _ have he : exp (-log 2 * (fordOccupancyCutoff v : ℝ)) ≤ exp (-log 2 * (v : ℝ) ^ (1 / 4 : ℝ)) := by apply exp_le_exp.mpr exact mul_le_mul_of_nonpos_left hceil (neg_nonpos.mpr (log_nonneg (by norm_num))) calc _ ≤ (v : ℝ) * exp 20 * exp (-log 2 * (fordOccupancyCutoff v : ℝ)) := ford_binomial_occupancy_exponential hv hkv _ _ ≤ (v : ℝ) * exp 20 * exp (-log 2 * (v : ℝ) ^ (1 / 4 : ℝ)) := mul_le_mul_of_nonneg_left he (by positivity) _ ≤ 1 / (v : ℝ) ^ 3 := by apply (le_div_iff₀ (by positivity : (0 : ℝ) < (v : ℝ) ^ 3)).mpr nlinarith only [hsmall.le] theorem ford_envelope_endpoint_decay (k : ℕ) (v : ℝ) : min 1 (((k : ℝ) + 1) * exp (log 2 * (v - k))) ≤ 2 * ((k : ℝ) + 1) / (1 + (2 : ℝ) ^ ((k : ℝ) - v)) := by let A : ℝ := (k : ℝ) + 1 let b : ℝ := (k : ℝ) - v have hA : 1 ≤ A := by dsimp [A]; linarith [Nat.cast_nonneg (α := ℝ) k] have hA0 : 0 ≤ A := le_trans zero_le_one hA have hlog : 0 ≤ log (2 : ℝ) := log_nonneg (by norm_num) have hmin : min 1 (A * exp (-log 2 * b)) ≤ A * min 1 (exp (-log 2 * b)) := by rw [mul_min_of_nonneg _ _ hA0, mul_one] exact le_min ((min_le_left _ _).trans hA) (min_le_right _ _) have heq : min 1 (exp (-log 2 * b)) = exp (-log 2 * max 0 b) := by by_cases hb : 0 ≤ b · rw [max_eq_right hb, min_eq_right (exp_le_one_iff.mpr (by nlinarith))] · have hb0 := le_of_not_ge hb rw [max_eq_left hb0, mul_zero, exp_zero, min_eq_left] exact one_le_exp_iff.mpr (by nlinarith) rw [heq] at hmin have h := hmin.trans (mul_le_mul_of_nonneg_left (ford_deficit_exponential_cutoff b) hA0) dsimp [A, b] at h rw [rpow_def_of_pos (by norm_num : (0 : ℝ) < 2)] rw [show log 2 * (v - (k : ℝ)) = -log 2 * ((k : ℝ) - v) by ring] exact h.trans_eq (by ring) theorem fordUnitEnvelopeMoment_finite_power_bound {k v R : ℕ} {t : ℝ} (hk : 0 < k) (hv : 0 < v) (hR : 0 < R) (hkhi : k ≤ 10 * v) (ht : 1 ≤ t) (hRt : (R : ℝ) ≤ 2 * t) (hsmall : (v : ℝ) * (k.choose R : ℝ) / (v : ℝ) ^ R ≤ 1 / (v : ℝ) ^ 3) : fordUnitEnvelopeMoment k (v : ℝ) ≤ 500000 * t * (1 + ((k : ℝ) - v) ^ 2) / (((k : ℝ) + 1) * (1 + (2 : ℝ) ^ ((k : ℝ) - v))) := by let N : ℝ := 1 + ((k : ℝ) - v) ^ 2 let D : ℝ := 1 + (2 : ℝ) ^ ((k : ℝ) - v) have hN : 1 ≤ N := by dsimp [N]; nlinarith [sq_nonneg ((k : ℝ) - v)] have hN0 : 0 ≤ N := le_trans zero_le_one hN have hD : 0 < D := by dsimp [D]; positivity have hkR : (0 : ℝ) < k := Nat.cast_pos.mpr hk have hk1 : (1 : ℝ) ≤ k := by exact_mod_cast hk have hvR : (0 : ℝ) < v := Nat.cast_pos.mpr hv have hv1 : (1 : ℝ) ≤ v := by exact_mod_cast hv have ht0 : 0 ≤ t := le_trans zero_le_one ht have hcoef : 27648 * (4 * (R : ℝ) + 1) / k ≤ 497664 * t / ((k : ℝ) + 1) := by apply (div_le_div_iff₀ hkR (by positivity : (0 : ℝ) < k + 1)).mpr have hR9 : 4 * (R : ℝ) + 1 ≤ 9 * t := by linarith have hkloR : (k : ℝ) + 1 ≤ 2 * k := by linarith have h1 := mul_le_mul_of_nonneg_right hR9 (show (0 : ℝ) ≤ k + 1 by positivity) have h2 := mul_le_mul_of_nonneg_left hkloR (show 0 ≤ 9 * t by positivity) nlinarith only [h1, h2] have hmain : (4 * (R : ℝ) + 1) * (27648 * N / ((k : ℝ) * D)) ≤ 497664 * t * N / (((k : ℝ) + 1) * D) := by calc _ = (27648 * (4 * (R : ℝ) + 1) / k) * (N / D) := by ring _ ≤ (497664 * t / ((k : ℝ) + 1)) * (N / D) := mul_le_mul_of_nonneg_right hcoef (div_nonneg hN0 hD.le) _ = _ := by rw [div_mul_div_comm] have hE : min 1 (((k : ℝ) + 1) * exp (log 2 * ((v : ℝ) - k))) ≤ 22 * v / D := by apply (ford_envelope_endpoint_decay k v).trans apply div_le_div_of_nonneg_right _ hD.le have hkhiR : (k : ℝ) ≤ 10 * v := by exact_mod_cast hkhi linarith have hprod : (k : ℝ) + 1 ≤ 11 * t * N * (v : ℝ) ^ 2 := by have htn : 1 ≤ t * N := by nlinarith [mul_nonneg (sub_nonneg.mpr ht) (sub_nonneg.mpr hN)] have hv2 : (v : ℝ) ≤ (v : ℝ) ^ 2 := by nlinarith have hkhiR : (k : ℝ) ≤ 10 * v := by exact_mod_cast hkhi nlinarith [mul_nonneg (sub_nonneg.mpr htn) (sq_nonneg (v : ℝ))] have herr : min 1 (((k : ℝ) + 1) * exp (log 2 * ((v : ℝ) - k))) * ((v : ℝ) * (k.choose R : ℝ) / (v : ℝ) ^ R) ≤ 242 * t * N / (((k : ℝ) + 1) * D) := by calc _ ≤ (22 * v / D) * (1 / (v : ℝ) ^ 3) := mul_le_mul hE hsmall (by positivity) (by positivity) _ = (22 / (v : ℝ) ^ 2) / D := by field_simp _ ≤ (242 * t * N / ((k : ℝ) + 1)) / D := by apply div_le_div_of_nonneg_right _ hD.le apply (div_le_div_iff₀ (by positivity : (0 : ℝ) < (v : ℝ) ^ 2) (by positivity : (0 : ℝ) < k + 1)).mpr nlinarith only [hprod] _ = _ := by rw [div_div] calc _ ≤ (4 * (R : ℝ) + 1) * (27648 * N / ((k : ℝ) * D)) + min 1 (((k : ℝ) + 1) * exp (log 2 * ((v : ℝ) - k))) * ((v : ℝ) * (k.choose R : ℝ) / (v : ℝ) ^ R) := fordUnitEnvelopeMoment_explicit_bound hk hv hR _ ≤ 497664 * t * N / (((k : ℝ) + 1) * D) + 242 * t * N / (((k : ℝ) + 1) * D) := add_le_add hmain herr _ ≤ _ := by change _ ≤ 500000 * t * N / (((k : ℝ) + 1) * D) rw [← add_div] apply div_le_div_of_nonneg_right _ (by positivity) nlinarith [mul_nonneg ht0 hN0] /-- Uniform in every positive cardinality at most `10v`. -/ theorem fordUnitEnvelopeMoment_eventual_power_bound : ∀ᶠ v : ℕ in atTop, ∀ k : ℕ, 0 < k → k ≤ 10 * v → fordUnitEnvelopeMoment k (v : ℝ) ≤ 500000 * (v : ℝ) ^ (1 / 4 : ℝ) * (1 + ((k : ℝ) - v) ^ 2) / (((k : ℝ) + 1) * (1 + (2 : ℝ) ^ ((k : ℝ) - v))) := by filter_upwards [ford_binomial_occupancy_eventually_small, eventually_gt_atTop 0] with v hsmall hv intro k hk hkhi have ht : 1 ≤ (v : ℝ) ^ (1 / 4 : ℝ) := one_le_rpow (by exact_mod_cast hv) (by norm_num) obtain ⟨hR, hRt⟩ := fordOccupancyCutoff_bounds hv exact fordUnitEnvelopeMoment_finite_power_bound hk hv hR hkhi ht hRt (hsmall k hkhi) theorem fordUnitEnvelopeMoment_eventual_power_bound_exp : ∀ᶠ v : ℕ in atTop, ∀ k : ℕ, 0 < k → k ≤ 10 * v → fordUnitEnvelopeMoment k (v : ℝ) ≤ 500000 * (v : ℝ) ^ (1 / 4 : ℝ) * (1 + ((k : ℝ) - v) ^ 2) / (((k : ℝ) + 1) * (1 + exp (log 2 * ((k : ℝ) - v)))) := by simpa only [rpow_def_of_pos (by norm_num : (0 : ℝ) < 2)] using fordUnitEnvelopeMoment_eventual_power_bound end Erdos859Verification end /- Inlined development module: FordSupportCardinalitySum.lean -/ section /- Summing the actual weighted prime support over the medium cardinalities. -/ open Finset Real MeasureTheory Filter open scoped Topology namespace Erdos859Verification theorem ford_powerset_sum_by_card {α : Type*} [DecidableEq α] (P : Finset α) (s : Finset ℕ) (f : Finset α → ℝ) : (∑ S ∈ P.powerset.filter (fun S ↦ S.card ∈ s), f S) = ∑ k ∈ s, ∑ S ∈ P.powerset.filter (fun S ↦ S.card = k), f S := (sum_fiberwise_eq_sum_filter P.powerset s Finset.card f).symm /-- The bound is uniform in the prime set, its upper cutoff, and the support width. -/ theorem ford_prime_support_medium_cardinality_sum : ∀ᶠ v : ℕ in atTop, ∀ (P : Finset ℕ) (N : ℕ) (d : ℝ), (∀ p ∈ P, p.Prime) → (∀ p ∈ P, p ≤ N) → 0 ≤ d → fordPrimeCumulativeOdds N ≤ log 2 * v → (∑ S ∈ P.powerset.filter (fun S ↦ 1 ≤ S.card ∧ S.card ≤ 10 * v), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) ≤ 250000000 * (d + fordPrimeCoordinateConstant) * (v : ℝ) ^ (1 / 4 : ℝ) * fordFactorialCoefficient v v := by filter_upwards [fordUnitEnvelopeMoment_eventual_power_bound_exp, eventually_ge_atTop 10] with v hmoment hv10 intro P N d hP hPN hd hM have hv : 0 < v := by omega have hvR : (0 : ℝ) < v := Nat.cast_pos.mpr hv have hDC : 0 ≤ d + fordPrimeCoordinateConstant := add_nonneg hd fordPrimeCoordinateConstant_pos.le have hlog : 0 ≤ log (2 : ℝ) := log_nonneg (by norm_num) have hcard (k : ℕ) (hk : k ∈ Icc 1 (10 * v)) : (∑ S ∈ P.powerset.filter (fun S ↦ S.card = k), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) ≤ (500000 * (d + fordPrimeCoordinateConstant) * (v : ℝ) ^ (1 / 4 : ℝ)) * fordCardinalityProfile v k := by have hkpos : 0 < k := by have := (mem_Icc.mp hk).1; omega have hkhi := (mem_Icc.mp hk).2 have hcoef : 0 ≤ (d + fordPrimeCoordinateConstant) * (2 * log 2 * v) ^ k / (k.factorial : ℝ) := by positivity calc _ ≤ ((d + fordPrimeCoordinateConstant) * (2 * log 2 * v) ^ k / (k.factorial : ℝ)) * fordUnitEnvelopeMoment k (v : ℝ) := ford_prime_support_unit_integral hP hPN hd hvR hM _ ≤ ((d + fordPrimeCoordinateConstant) * (2 * log 2 * v) ^ k / (k.factorial : ℝ)) * (500000 * (v : ℝ) ^ (1 / 4 : ℝ) * (1 + ((k : ℝ) - v) ^ 2) / (((k : ℝ) + 1) * (1 + exp (log 2 * ((k : ℝ) - v))))) := mul_le_mul_of_nonneg_left (hmoment k hkpos hkhi) hcoef _ = _ := by unfold fordCardinalityProfile fordFactorialCoefficient rw [Nat.factorial_succ, Nat.cast_mul, Nat.cast_add, Nat.cast_one] field_simp calc _ = ∑ k ∈ Icc 1 (10 * v), ∑ S ∈ P.powerset.filter (fun S ↦ S.card = k), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d) := by simpa only [mem_Icc] using ford_powerset_sum_by_card P (Icc 1 (10 * v)) (fun S ↦ (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) _ ≤ ∑ k ∈ Icc 1 (10 * v), (500000 * (d + fordPrimeCoordinateConstant) * (v : ℝ) ^ (1 / 4 : ℝ)) * fordCardinalityProfile v k := sum_le_sum fun k hk ↦ hcard k hk _ = (500000 * (d + fordPrimeCoordinateConstant) * (v : ℝ) ^ (1 / 4 : ℝ)) * ∑ k ∈ Icc 1 (10 * v), fordCardinalityProfile v k := by rw [mul_sum] _ ≤ (500000 * (d + fordPrimeCoordinateConstant) * (v : ℝ) ^ (1 / 4 : ℝ)) * (500 * fordFactorialCoefficient v v) := mul_le_mul_of_nonneg_left (fordCardinalityProfile_sum_bound hv10 _) (by positivity) _ = _ := by ring end Erdos859Verification end /- Inlined development module: FordCriticalStirling.lean -/ section /- Stirling's lower bound gives the required logarithmic power saving. -/ open Real namespace Erdos859Verification noncomputable def fordCriticalRate : ℝ := log 2 + 1 + log (log 2) noncomputable def fordUpperExponent : ℝ := fordCriticalRate / log 2 theorem fordCriticalRate_pos : 0 < fordCriticalRate := by have hl : 0 < log (2 : ℝ) := log_pos (by norm_num) have hhalf : (1 / 2 : ℝ) < log 2 := by linarith [log_two_gt_d9] have h := log_lt_log (by norm_num : (0 : ℝ) < 1 / 2) hhalf rw [log_div (by norm_num : (1 : ℝ) ≠ 0) (by norm_num : (2 : ℝ) ≠ 0), log_one] at h unfold fordCriticalRate linarith theorem fordUpperExponent_pos : 0 < fordUpperExponent := div_pos fordCriticalRate_pos (log_pos (by norm_num)) theorem fordUpperExponent_eq : fordUpperExponent = 1 + (1 + log (log 2)) / log 2 := by unfold fordUpperExponent fordCriticalRate field_simp ring theorem fordFactorialCoefficient_log_stirling {v : ℕ} (hv : 0 < v) : log (fordFactorialCoefficient v v) ≤ fordCriticalRate * v - (3 / 2 : ℝ) * log (v : ℝ) := by have hvr : (0 : ℝ) < v := by exact_mod_cast hv have hl : 0 < log (2 : ℝ) := log_pos (by norm_num) have hfac : (0 : ℝ) < v.factorial := by positivity have hfac1 : (0 : ℝ) < (v + 1).factorial := by positivity have hs := Stirling.le_log_factorial_stirling hv.ne' have hpi : 0 ≤ log (2 * π) := log_nonneg (by linarith [pi_gt_three]) have hnext : log (v : ℝ) ≤ log ((v : ℝ) + 1) := log_le_log hvr (by linarith) have hid : log (((v + 1).factorial : ℝ)) = log ((v : ℝ) + 1) + log (v.factorial : ℝ) := by rw [Nat.factorial_succ, Nat.cast_mul, Nat.cast_add, Nat.cast_one, log_mul (by positivity) hfac.ne'] have hlog : log (fordFactorialCoefficient v v) = (v : ℝ) * (log 2 + log (log 2) + log (v : ℝ)) - log (((v + 1).factorial : ℝ)) := by unfold fordFactorialCoefficient rw [log_div (by positivity) hfac1.ne', log_pow, log_mul (by positivity : 2 * log (2 : ℝ) ≠ 0) hvr.ne', log_mul (by norm_num : (2 : ℝ) ≠ 0) hl.ne'] rw [hlog, hid] unfold fordCriticalRate linarith theorem fordFactorialCoefficient_stirling {v : ℕ} (hv : 0 < v) : fordFactorialCoefficient v v ≤ exp (fordCriticalRate * v) / (v : ℝ) ^ (3 / 2 : ℝ) := by have hvr : (0 : ℝ) < v := by exact_mod_cast hv have hpos : 0 < fordFactorialCoefficient v v := by unfold fordFactorialCoefficient have : 0 < log (2 : ℝ) := log_pos (by norm_num) positivity calc _ = exp (log (fordFactorialCoefficient v v)) := (exp_log hpos).symm _ ≤ exp (fordCriticalRate * v - (3 / 2 : ℝ) * log (v : ℝ)) := exp_le_exp.mpr (fordFactorialCoefficient_log_stirling hv) _ = _ := by rw [exp_sub, rpow_def_of_pos hvr]; congr 2; ring theorem fordFactorialCoefficient_quarter_stirling {v : ℕ} (hv : 0 < v) : (v : ℝ) ^ (1 / 4 : ℝ) * fordFactorialCoefficient v v ≤ exp (fordCriticalRate * v) / (v : ℝ) ^ (5 / 4 : ℝ) := by have hvr : (0 : ℝ) < v := by exact_mod_cast hv calc _ ≤ (v : ℝ) ^ (1 / 4 : ℝ) * (exp (fordCriticalRate * v) / (v : ℝ) ^ (3 / 2 : ℝ)) := mul_le_mul_of_nonneg_left (fordFactorialCoefficient_stirling hv) (by positivity) _ = _ := by rw [rpow_def_of_pos hvr, rpow_def_of_pos hvr, rpow_def_of_pos hvr] rw [← mul_div_assoc, ← exp_add, ← exp_sub, ← exp_sub] congr 1 ring noncomputable def fordStirlingConversionConstant : ℝ := exp (fordUpperExponent * (fordCumulativeShiftConstant + log 2)) * (2 * log 2) ^ (5 / 4 : ℝ) theorem fordStirlingConversionConstant_pos : 0 < fordStirlingConversionConstant := by unfold fordStirlingConversionConstant have : 0 < log (2 : ℝ) := log_pos (by norm_num) positivity theorem fordPrimeCubeScale_critical_bound {N : ℕ} (hN : 2 ≤ N) (hlarge : 2 * (fordCumulativeShiftConstant + log 2) ≤ log (log (N : ℝ))) : (fordPrimeCubeScale N : ℝ) ^ (1 / 4 : ℝ) * fordFactorialCoefficient (fordPrimeCubeScale N) (fordPrimeCubeScale N) ≤ fordStirlingConversionConstant * (log (N : ℝ)) ^ fordUpperExponent / (log (log (N : ℝ))) ^ (5 / 4 : ℝ) := by let v := fordPrimeCubeScale N let C := fordCumulativeShiftConstant + log 2 have hl : 0 < log (2 : ℝ) := log_pos (by norm_num) have hC : 0 < C := add_pos fordCumulativeShiftConstant_pos hl have hL : 0 < log (log (N : ℝ)) := by linarith have hlogN : 0 < log (N : ℝ) := log_pos (by exact_mod_cast (by omega : 1 < N)) have hv := fordPrimeCubeScale_pos hN have hvr : (0 : ℝ) < v := by exact_mod_cast hv have hshift := abs_le.mp (fordPrimeCubeScale_loglog hN) have hlow : log (log (N : ℝ)) / (2 * log 2) ≤ (v : ℝ) := by apply (div_le_iff₀ (by positivity : 0 < 2 * log (2 : ℝ))).mpr change log (log (N : ℝ)) ≤ (v : ℝ) * (2 * log 2) dsimp only [v] linarith have hexp : exp (fordCriticalRate * (v : ℝ)) ≤ exp (fordUpperExponent * C) * (log (N : ℝ)) ^ fordUpperExponent := by rw [rpow_def_of_pos hlogN, ← exp_add] apply exp_le_exp.mpr have hm := mul_le_mul_of_nonneg_left hshift.2 fordUpperExponent_pos.le have hid : fordUpperExponent * (log 2 * (v : ℝ)) = fordCriticalRate * v := by unfold fordUpperExponent field_simp dsimp only [v, C] at * nlinarith have hpow := rpow_le_rpow (by positivity : 0 ≤ log (log (N : ℝ)) / (2 * log 2)) hlow (by norm_num : (0 : ℝ) ≤ 5 / 4) calc _ ≤ exp (fordCriticalRate * v) / (v : ℝ) ^ (5 / 4 : ℝ) := fordFactorialCoefficient_quarter_stirling hv _ ≤ (exp (fordUpperExponent * C) * (log (N : ℝ)) ^ fordUpperExponent) / (log (log (N : ℝ)) / (2 * log 2)) ^ (5 / 4 : ℝ) := div_le_div₀ (by positivity) hexp (by positivity) hpow _ = _ := by rw [div_rpow hL.le (by positivity)] unfold fordStirlingConversionConstant dsimp only [C] rw [div_div_eq_mul_div] ring end Erdos859Verification end /- Inlined development module: FordSupportTail.lean -/ section /- A direct generating-function estimate for the large-cardinality support tail. -/ open Finset Real MeasureTheory namespace Erdos859Verification theorem ford_subset_cardinality_generating {α : Type*} (P : Finset α) (w : α → ℝ) (c : ℝ) : (∑ S ∈ P.powerset, (∏ p ∈ S, w p) * c ^ S.card) = ∏ p ∈ P, (1 + c * w p) := by classical rw [prod_one_add] apply sum_congr rfl intro S _ rw [prod_mul_distrib, prod_const] ring theorem ford_subset_cardinality_generating_le {α : Type*} (P : Finset α) (w : α → ℝ) (hw : ∀ p ∈ P, 0 ≤ w p) {c : ℝ} (hc : 0 ≤ c) : (∑ S ∈ P.powerset, (∏ p ∈ S, w p) * c ^ S.card) ≤ exp (c * ∑ p ∈ P, w p) := by rw [ford_subset_cardinality_generating, mul_sum, exp_sum] apply Finset.prod_le_prod · intro p hp exact add_nonneg zero_le_one (mul_nonneg hc (hw p hp)) · intro p _ linarith [add_one_le_exp (c * w p)] theorem fordPrimeOdds_sum_le_cumulative {P : Finset ℕ} {N : ℕ} (hP : ∀ p ∈ P, p.Prime) (hPN : ∀ p ∈ P, p ≤ N) : (∑ p ∈ P, fordPrimeOdds p) ≤ fordPrimeCumulativeOdds N := by apply sum_le_sum_of_subset_of_nonneg · intro p hp exact mem_filter.mpr ⟨mem_Ioc.mpr ⟨(hP p hp).pos, hPN p hp⟩, hP p hp⟩ · intro p _ _ exact fordPrimeOdds_nonneg p theorem ford_prime_support_high_cardinality {P : Finset ℕ} {N v : ℕ} (hP : ∀ p ∈ P, p.Prime) (hPN : ∀ p ∈ P, p ≤ N) {d : ℝ} (hd : 0 ≤ d) (hM : fordPrimeCumulativeOdds N ≤ log 2 * v) : (∑ S ∈ P.powerset.filter (fun S ↦ 10 * v < S.card), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) ≤ d := by have hl : 0 ≤ log (2 : ℝ) := (log_pos (by norm_num : (1 : ℝ) < 2)).le have hmass := (fordPrimeOdds_sum_le_cumulative hP hPN).trans hM have hgen := ford_subset_cardinality_generating_le P fordPrimeOdds (fun p _ ↦ fordPrimeOdds_nonneg p) (c := 4) (by norm_num) have hexp : exp (4 * ∑ p ∈ P, fordPrimeOdds p) ≤ (2 : ℝ) ^ (10 * v) := by rw [← exp_log (by norm_num : (0 : ℝ) < 2), ← exp_nat_mul] apply exp_le_exp.mpr push_cast nlinarith [mul_nonneg hl (Nat.cast_nonneg (α := ℝ) v)] have hpoint : ∀ S ∈ P.powerset.filter (fun S ↦ 10 * v < S.card), (2 : ℝ) ^ (10 * v) * ((∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) ≤ d * ((∏ p ∈ S, fordPrimeOdds p) * (4 : ℝ) ^ S.card) := by intro S hS have hcard := (mem_filter.mp hS).2 have hpow : (2 : ℝ) ^ (10 * v) ≤ (2 : ℝ) ^ S.card := pow_le_pow_right₀ (by norm_num) hcard.le have hlen := primeSubsetSumSupport_measure_le_card S hd have hw : 0 ≤ ∏ p ∈ S, fordPrimeOdds p := prod_nonneg fun p _ ↦ fordPrimeOdds_nonneg p calc _ ≤ (2 : ℝ) ^ (10 * v) * ((∏ p ∈ S, fordPrimeOdds p) * ((2 : ℝ) ^ S.card * d)) := mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left hlen hw) (by positivity) _ ≤ (2 : ℝ) ^ S.card * ((∏ p ∈ S, fordPrimeOdds p) * ((2 : ℝ) ^ S.card * d)) := mul_le_mul_of_nonneg_right hpow (by positivity) _ = _ := by rw [show (4 : ℝ) = 2 * 2 by norm_num, mul_pow]; ring have hsum : (2 : ℝ) ^ (10 * v) * (∑ S ∈ P.powerset.filter (fun S ↦ 10 * v < S.card), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) ≤ (2 : ℝ) ^ (10 * v) * d := by calc _ ≤ d * ∑ S ∈ P.powerset.filter (fun S ↦ 10 * v < S.card), (∏ p ∈ S, fordPrimeOdds p) * (4 : ℝ) ^ S.card := by rw [mul_sum, mul_sum] exact sum_le_sum hpoint _ ≤ d * ∑ S ∈ P.powerset, (∏ p ∈ S, fordPrimeOdds p) * (4 : ℝ) ^ S.card := by apply mul_le_mul_of_nonneg_left _ hd apply sum_le_sum_of_subset_of_nonneg (filter_subset _ _) intro S _ _ exact mul_nonneg (prod_nonneg fun p _ ↦ fordPrimeOdds_nonneg p) (by positivity) _ ≤ d * (2 : ℝ) ^ (10 * v) := mul_le_mul_of_nonneg_left (hgen.trans hexp) hd _ = _ := mul_comm _ _ exact (mul_le_mul_iff_right₀ (by positivity : 0 < (2 : ℝ) ^ (10 * v))).mp hsum theorem ford_prime_support_cardinality_zero (P : Finset ℕ) {d : ℝ} (hd : 0 ≤ d) : (∑ S ∈ P.powerset.filter (fun S ↦ S.card = 0), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) ≤ d := by have hset : P.powerset.filter (fun S ↦ S.card = 0) = {∅} := by ext S simp only [mem_filter, mem_powerset, card_eq_zero, mem_singleton] constructor · exact fun h ↦ h.2 · intro h exact ⟨h ▸ empty_subset P, h⟩ rw [hset, sum_singleton, prod_empty, one_mul] simpa using primeSubsetSumSupport_measure_le_card (∅ : Finset ℕ) hd end Erdos859Verification end /- Inlined development module: FordSupportTotal.lean -/ section /- The full finite support sum, including zero and large cardinalities. -/ open Finset Real Filter MeasureTheory open scoped Topology namespace Erdos859Verification theorem fordPrimeCubeScale_tendsto_atTop : Tendsto fordPrimeCubeScale atTop atTop := by have hl : 0 < log (2 : ℝ) := log_pos (by norm_num) have hloglog : Tendsto (fun N : ℕ ↦ log (log (N : ℝ))) atTop atTop := tendsto_log_atTop.comp (tendsto_log_atTop.comp tendsto_natCast_atTop_atTop) have hreal : Tendsto (fun N : ℕ ↦ (fordPrimeCubeScale N : ℝ)) atTop atTop := by have hsub : Tendsto (fun N : ℕ ↦ log (log (N : ℝ)) - (fordCumulativeShiftConstant + log 2)) atTop atTop := by simpa only [sub_eq_add_neg] using tendsto_atTop_add_const_right atTop (-(fordCumulativeShiftConstant + log 2)) hloglog apply tendsto_atTop_mono' atTop _ (hsub.atTop_div_const hl) filter_upwards [eventually_ge_atTop 2] with N hN have h := (abs_le.mp (fordPrimeCubeScale_loglog hN)).1 apply (div_le_iff₀ hl).mpr linarith exact tendsto_natCast_atTop_iff.mp hreal theorem ford_prime_support_total_by_scale : ∀ᶠ v : ℕ in atTop, ∀ (P : Finset ℕ) (N : ℕ) (d : ℝ), (∀ p ∈ P, p.Prime) → (∀ p ∈ P, p ≤ N) → 0 ≤ d → fordPrimeCumulativeOdds N ≤ log 2 * v → insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) ≤ 2 * d + 250000000 * (d + fordPrimeCoordinateConstant) * (v : ℝ) ^ (1 / 4 : ℝ) * fordFactorialCoefficient v v := by filter_upwards [ford_prime_support_medium_cardinality_sum] with v hv intro P N d hP hPN hd hM have hzero := ford_prime_support_cardinality_zero P hd have hmedium := hv P N d hP hPN hd hM have hhigh := ford_prime_support_high_cardinality hP hPN hd hM have hsplit : insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) = (∑ S ∈ P.powerset.filter (fun S ↦ S.card = 0), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) + (∑ S ∈ P.powerset.filter (fun S ↦ 1 ≤ S.card ∧ S.card ≤ 10 * v), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) + (∑ S ∈ P.powerset.filter (fun S ↦ 10 * v < S.card), (∏ p ∈ S, fordPrimeOdds p) * volume.real (primeSubsetSumSupport S d)) := by unfold insertionWeightedSum rw [sum_filter, sum_filter, sum_filter, ← sum_add_distrib, ← sum_add_distrib] apply sum_congr rfl intro S _ by_cases hz : S.card = 0 · simp [hz] · have hpos : 1 ≤ S.card := by omega by_cases hm : S.card ≤ 10 * v · simp [hz, hpos, hm, not_lt.mpr hm] · simp [hz, hpos, hm, lt_of_not_ge hm] rw [hsplit] linarith noncomputable def fordSupportTotalConstant : ℝ := 250000000 * fordStirlingConversionConstant theorem fordSupportTotalConstant_pos : 0 < fordSupportTotalConstant := mul_pos (by norm_num) fordStirlingConversionConstant_pos theorem ford_prime_support_total_logarithmic : ∀ᶠ N : ℕ in atTop, ∀ (P : Finset ℕ) (d : ℝ), (∀ p ∈ P, p.Prime) → (∀ p ∈ P, p ≤ N) → 0 ≤ d → insertionWeightedSum P fordPrimeOdds (fun S ↦ volume.real (primeSubsetSumSupport S d)) ≤ 2 * d + fordSupportTotalConstant * (d + fordPrimeCoordinateConstant) * (log (N : ℝ)) ^ fordUpperExponent / (log (log (N : ℝ))) ^ (5 / 4 : ℝ) := by have hloglog : Tendsto (fun N : ℕ ↦ log (log (N : ℝ))) atTop atTop := tendsto_log_atTop.comp (tendsto_log_atTop.comp tendsto_natCast_atTop_atTop) filter_upwards [fordPrimeCubeScale_tendsto_atTop.eventually ford_prime_support_total_by_scale, eventually_ge_atTop 2, hloglog.eventually_ge_atTop (2 * (fordCumulativeShiftConstant + log 2))] with N hscale hN hlarge intro P d hP hPN hd have hsum := hscale P N d hP hPN hd (fordPrimeCubeScale_covers N) have hcrit := fordPrimeCubeScale_critical_bound hN hlarge have hcoef : 0 ≤ 250000000 * (d + fordPrimeCoordinateConstant) := by have := fordPrimeCoordinateConstant_pos positivity have hm := mul_le_mul_of_nonneg_left hcrit hcoef apply hsum.trans unfold fordSupportTotalConstant convert add_le_add_left hm (2 * d) using 1 <;> ring end Erdos859Verification end /- Inlined development module: CoreBlockParameterSequence.lean -/ section /- An explicit subsequence of block lengths, suffix lengths, and total counts. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification def coreRateBlockLength (s : ℕ) : ℕ := 2 ^ s def coreRateSuffixLength (s : ℕ) : ℕ := 2 * s + 4 def coreRatePrefixLength (s : ℕ) : ℕ := coreRateBlockLength s - coreRateSuffixLength s def coreRateBlockCount (s : ℕ) : ℕ := 2 ^ (4 * coreRateBlockLength s) def coreRateTotalLength (s : ℕ) : ℕ := coreRateBlockLength s * coreRateBlockCount s def coreRateHead (s : ℕ) : ℕ := 10 * coreRateBlockLength s theorem coreRateBlockLength_pos (s : ℕ) : 0 < coreRateBlockLength s := by unfold coreRateBlockLength positivity theorem coreRateBlockCount_pos (s : ℕ) : 0 < coreRateBlockCount s := by unfold coreRateBlockCount positivity theorem coreRateTotalLength_pos (s : ℕ) : 0 < coreRateTotalLength s := Nat.mul_pos (coreRateBlockLength_pos s) (coreRateBlockCount_pos s) theorem coreRateBlockLength_le_total (s : ℕ) : coreRateBlockLength s ≤ coreRateTotalLength s := by unfold coreRateTotalLength simpa only [Nat.mul_one] using Nat.mul_le_mul_left (coreRateBlockLength s) (coreRateBlockCount_pos s) theorem coreRateBlockLength_tendsto : Tendsto coreRateBlockLength atTop atTop := tendsto_pow_atTop_atTop_of_one_lt (by norm_num : (1 : ℕ) < 2) theorem coreRateTotalLength_tendsto : Tendsto coreRateTotalLength atTop atTop := tendsto_atTop_mono coreRateBlockLength_le_total coreRateBlockLength_tendsto theorem coreRateBlockLength_real_tendsto : Tendsto (fun s ↦ (coreRateBlockLength s : ℝ)) atTop atTop := (tendsto_natCast_atTop_atTop (R := ℝ)).comp coreRateBlockLength_tendsto theorem coreRateTotalLength_real_tendsto : Tendsto (fun s ↦ (coreRateTotalLength s : ℝ)) atTop atTop := (tendsto_natCast_atTop_atTop (R := ℝ)).comp coreRateTotalLength_tendsto theorem coreRateSuffix_fraction_tendsto : Tendsto (fun s ↦ (coreRateSuffixLength s : ℝ) / coreRateBlockLength s) atTop (𝓝 0) := by have hs : Tendsto (fun s : ℕ ↦ (s : ℝ) / (2 : ℝ) ^ s) atTop (𝓝 0) := by simpa only [pow_one] using tendsto_pow_const_div_const_pow_of_one_lt 1 (by norm_num : (1 : ℝ) < 2) have hconst := coreRateBlockLength_real_tendsto.const_div_atTop (4 : ℝ) convert (hs.const_mul 2).add hconst using 1 <;> simp only [coreRateSuffixLength, coreRateBlockLength, Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat, Nat.cast_pow, add_div, mul_div_assoc, mul_zero, zero_add] theorem coreRateLength_eventually_split : ∀ᶠ s : ℕ in atTop, 0 < coreRatePrefixLength s ∧ coreRatePrefixLength s + coreRateSuffixLength s = coreRateBlockLength s := by filter_upwards [coreRateSuffix_fraction_tendsto.eventually_lt_const (by norm_num : (0 : ℝ) < 1)] with s hs have hH : (0 : ℝ) < coreRateBlockLength s := by exact_mod_cast coreRateBlockLength_pos s have hKH : coreRateSuffixLength s < coreRateBlockLength s := by exact_mod_cast (div_lt_one hH).mp hs exact ⟨Nat.sub_pos_of_lt hKH, Nat.sub_add_cancel hKH.le⟩ theorem coreRatePrefix_fraction_tendsto : Tendsto (fun s ↦ (coreRatePrefixLength s : ℝ) / coreRateBlockLength s) atTop (𝓝 1) := by have hlim := (tendsto_const_nhds : Tendsto (fun _ : ℕ ↦ (1 : ℝ)) atTop (𝓝 1)).sub coreRateSuffix_fraction_tendsto simp only [sub_zero] at hlim apply hlim.congr' filter_upwards [coreRateLength_eventually_split] with s hs have hsplit : (coreRatePrefixLength s : ℝ) + coreRateSuffixLength s = coreRateBlockLength s := by exact_mod_cast hs.2 have hH : (coreRateBlockLength s : ℝ) ≠ 0 := by exact_mod_cast (coreRateBlockLength_pos s).ne' field_simp linarith theorem coreRate_length_div_count_tendsto : Tendsto (fun s ↦ (coreRateBlockLength s : ℝ) / coreRateBlockCount s) atTop (𝓝 0) := by have h := (tendsto_pow_const_div_const_pow_of_one_lt 1 (by norm_num : (1 : ℝ) < 16)).comp coreRateBlockLength_tendsto simpa only [Function.comp_def, pow_one, coreRateBlockCount, Nat.cast_pow, Nat.cast_ofNat, pow_mul, show (2 : ℝ) ^ 4 = 16 by norm_num] using h theorem coreRate_squared_length_div_total_tendsto : Tendsto (fun s ↦ (coreRateBlockLength s : ℝ) ^ 2 / coreRateTotalLength s) atTop (𝓝 0) := by apply coreRate_length_div_count_tendsto.congr' exact Eventually.of_forall fun s ↦ by have hH : (coreRateBlockLength s : ℝ) ≠ 0 := by exact_mod_cast (coreRateBlockLength_pos s).ne' simp only [coreRateTotalLength, Nat.cast_mul] field_simp theorem coreRateHead_eventually_le_global : ∀ᶠ s : ℕ in atTop, coreRateHead s ≤ coreBallotHeadCount (coreRateTotalLength s) := by filter_upwards [coreRate_length_div_count_tendsto.eventually_lt_const (by norm_num : (0 : ℝ) < 1 / 100)] with s hs have hR : (0 : ℝ) < coreRateBlockCount s := by exact_mod_cast coreRateBlockCount_pos s have hH : (0 : ℝ) < coreRateBlockLength s := by exact_mod_cast coreRateBlockLength_pos s have hsmall := (div_lt_iff₀ hR).mp hs have hsq : (coreRateHead s : ℝ) ^ 2 ≤ coreRateTotalLength s := by simp only [coreRateHead, coreRateTotalLength, Nat.cast_mul, Nat.cast_ofNat] nlinarith [mul_pos hH (show 0 < (coreRateBlockCount s : ℝ) - 100 * coreRateBlockLength s by linarith)] have hle : (coreRateHead s : ℝ) ≤ sqrt (coreRateTotalLength s : ℝ) := (le_sqrt (by positivity) (by positivity)).mpr hsq exact_mod_cast hle.trans (coreBallotHeadCount_sqrt_bounds (coreRateTotalLength s)).1 theorem coreRate_ratio_le_pow_head (s : ℕ) : coreBallotShift (coreRateTotalLength s) / coreBallotScale (coreRateTotalLength s) ≤ (2 : ℝ) ^ coreRateHead s := by have hH : 1 ≤ coreRateBlockLength s := coreRateBlockLength_pos s have hpow : coreRateBlockLength s ≤ 2 ^ coreRateBlockLength s := (coreRateBlockLength s).lt_two_pow_self.le have hten : 10 ≤ 2 ^ (5 * coreRateBlockLength s) := by calc 10 ≤ 2 ^ (5 : ℕ) := by norm_num _ ≤ _ := Nat.pow_le_pow_right (by norm_num) (by omega) have hbound : 10 * coreRateTotalLength s ≤ 2 ^ coreRateHead s := by calc _ ≤ 2 ^ (5 * coreRateBlockLength s) * (2 ^ coreRateBlockLength s * 2 ^ (4 * coreRateBlockLength s)) := by unfold coreRateTotalLength coreRateBlockCount exact Nat.mul_le_mul hten (Nat.mul_le_mul_right _ hpow) _ = _ := by rw [← pow_add, ← pow_add] congr 1 unfold coreRateHead omega exact (coreBallotShift_div_scale_le (coreRateTotalLength s)).trans (by exact_mod_cast hbound) theorem coreRate_endpoint_epsilon_tendsto : Tendsto (fun s ↦ (coreRatePrefixLength s : ℝ) / (2 : ℝ) ^ coreRateSuffixLength s) atTop (𝓝 0) := by have hgeom := (tendsto_pow_atTop_nhds_zero_of_lt_one (by norm_num : (0 : ℝ) ≤ 1 / 2) (by norm_num : (1 : ℝ) / 2 < 1)).const_mul (1 / 16 : ℝ) apply squeeze_zero (fun s ↦ by positivity) (fun s ↦ ?_) (by simpa only [mul_zero] using hgeom) have hnH : (coreRatePrefixLength s : ℝ) ≤ coreRateBlockLength s := by exact_mod_cast Nat.sub_le (coreRateBlockLength s) (coreRateSuffixLength s) calc _ ≤ (coreRateBlockLength s : ℝ) / (2 : ℝ) ^ coreRateSuffixLength s := div_le_div_of_nonneg_right hnH (by positivity) _ = (1 / 16 : ℝ) * (1 / 2 : ℝ) ^ s := by simp only [coreRateBlockLength, coreRateSuffixLength, Nat.cast_pow, Nat.cast_ofNat, pow_add, pow_mul, div_pow, one_pow] rw [show (2 : ℝ) ^ 2 = 2 * 2 by norm_num, mul_pow] field_simp ring theorem coreRate_endpoint_budget_tendsto (eta : ℝ) : Tendsto (fun s ↦ (exp eta + (coreRatePrefixLength s : ℝ) / (2 : ℝ) ^ coreRateSuffixLength s) / (1 - ((2 : ℝ) ^ coreRateBlockLength s)⁻¹)) atTop (𝓝 (exp eta)) := by have hgeom := (tendsto_pow_atTop_nhds_zero_of_lt_one (by norm_num : (0 : ℝ) ≤ 1 / 2) (by norm_num : (1 : ℝ) / 2 < 1)).comp coreRateBlockLength_tendsto have hinv : Tendsto (fun s ↦ ((2 : ℝ) ^ coreRateBlockLength s)⁻¹) atTop (𝓝 0) := by simpa only [Function.comp_def, div_pow, one_pow, one_div, inv_pow] using hgeom simpa only [add_zero, sub_zero, div_one] using! (tendsto_const_nhds.add coreRate_endpoint_epsilon_tendsto).div (tendsto_const_nhds.sub hinv) (by norm_num : (1 : ℝ) - 0 ≠ 0) end Erdos859Verification end /- Inlined development module: CoreBlockParameterRate.lean -/ section /- The explicit actual multiblock event has the desired exponential rate. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification noncomputable def coreRateHeadLoss (s : ℕ) : ℝ := (min (coreRateBlockCount s) (coreRateHead s / (coreRatePrefixLength s + coreRateSuffixLength s) + 1) : ℕ) * (coreRateHead s : ℝ) * (coreRateHead s + 1 : ℕ) * log 2 noncomputable def coreRateCost (eta lam : ℝ) (s : ℕ) : ℝ := coreMultiBlockCostUpper (coreBallotShift (coreRateTotalLength s)) (coreBallotScale (coreRateTotalLength s)) eta lam (coreRatePrefixLength s) (coreRateSuffixLength s) (coreRateBlockCount s) (coreRateHead s) theorem coreRateHeadLoss_polynomial_bound {s : ℕ} (hsplit : coreRatePrefixLength s + coreRateSuffixLength s = coreRateBlockLength s) : coreRateHeadLoss s ≤ 1210 * (coreRateBlockLength s : ℝ) ^ 2 * log 2 := by have hH : 0 < coreRateBlockLength s := coreRateBlockLength_pos s have hH1 : (1 : ℝ) ≤ coreRateBlockLength s := by exact_mod_cast hH have hdiv : coreRateHead s / (coreRatePrefixLength s + coreRateSuffixLength s) + 1 = 11 := by rw [hsplit, coreRateHead, Nat.mul_div_left _ hH] have hmin : ((min (coreRateBlockCount s) (coreRateHead s / (coreRatePrefixLength s + coreRateSuffixLength s) + 1) : ℕ) : ℝ) ≤ 11 := by rw [hdiv] exact_mod_cast min_le_right (coreRateBlockCount s) 11 have hplus : (coreRateHead s + 1 : ℕ) ≤ (11 : ℝ) * coreRateBlockLength s := by simp only [coreRateHead, Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat, Nat.cast_one] linarith have hmul := mul_le_mul (mul_le_mul_of_nonneg_right hmin (Nat.cast_nonneg (coreRateHead s))) hplus (Nat.cast_nonneg (coreRateHead s + 1)) (by positivity : 0 ≤ 11 * (coreRateHead s : ℝ)) have hfinal := mul_le_mul_of_nonneg_right hmul (log_nonneg (by norm_num : (1 : ℝ) ≤ 2)) convert hfinal using 1 <;> first | rfl | (simp only [coreRateHead, Nat.cast_mul, Nat.cast_ofNat]; ring) theorem coreRateHeadLoss_div_tendsto : Tendsto (fun s ↦ coreRateHeadLoss s / coreRateTotalLength s) atTop (𝓝 0) := by have hlim := coreRate_squared_length_div_total_tendsto.const_mul (1210 * log 2) simp only [mul_zero] at hlim apply squeeze_zero' (Eventually.of_forall fun s ↦ by unfold coreRateHeadLoss positivity [log_nonneg (by norm_num : (1 : ℝ) ≤ 2)]) _ hlim filter_upwards [coreRateLength_eventually_split] with s hs convert div_le_div_of_nonneg_right (coreRateHeadLoss_polynomial_bound hs.2) (Nat.cast_nonneg (coreRateTotalLength s)) using 1 <;> first | rfl | ring theorem coreRateHead_square_div_tendsto : Tendsto (fun s ↦ ((coreRateHead s + 1 : ℕ) : ℝ) ^ 2 / coreRateTotalLength s) atTop (𝓝 0) := by have hlim := coreRate_squared_length_div_total_tendsto.const_mul 121 simp only [mul_zero] at hlim apply squeeze_zero (fun s ↦ by positivity) (fun s ↦ ?_) hlim have hH1 : (1 : ℝ) ≤ coreRateBlockLength s := by exact_mod_cast coreRateBlockLength_pos s have hplus : ((coreRateHead s + 1 : ℕ) : ℝ) ≤ 11 * coreRateBlockLength s := by simp only [coreRateHead, Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat, Nat.cast_one] linarith have hsq : ((coreRateHead s + 1 : ℕ) : ℝ) ^ 2 ≤ 121 * (coreRateBlockLength s : ℝ) ^ 2 := by nlinarith [sq_nonneg (((coreRateHead s + 1 : ℕ) : ℝ) - 11 * coreRateBlockLength s)] convert div_le_div_of_nonneg_right hsq (Nat.cast_nonneg (coreRateTotalLength s)) using 1 <;> first | rfl | ring theorem coreRate_log_prefix_div_length_tendsto : Tendsto (fun s ↦ log (coreRatePrefixLength s : ℝ) / coreRateBlockLength s) atTop (𝓝 0) := by have hlog := isLittleO_log_id_atTop.tendsto_div_nhds_zero.comp coreRateBlockLength_real_tendsto apply squeeze_zero' _ _ hlog · filter_upwards [coreRateLength_eventually_split] with s hs exact div_nonneg (log_nonneg (by exact_mod_cast hs.1)) (Nat.cast_nonneg _) · filter_upwards [coreRateLength_eventually_split] with s hs have hn : (0 : ℝ) < coreRatePrefixLength s := by exact_mod_cast hs.1 have hnH : (coreRatePrefixLength s : ℝ) ≤ coreRateBlockLength s := by exact_mod_cast (show coreRatePrefixLength s ≤ coreRateBlockLength s from Nat.sub_le (coreRateBlockLength s) (coreRateSuffixLength s)) simpa only [Function.comp_def, id_eq] using! div_le_div_of_nonneg_right (log_le_log hn hnH) (Nat.cast_nonneg (coreRateBlockLength s)) theorem coreRate_relative_cost_div_tendsto : Tendsto (fun s ↦ (4 * (coreRatePrefixLength s : ℝ) * virtualPrimeRelativeError (coreBallotScale (coreRateTotalLength s))) / coreRateTotalLength s) atTop (𝓝 0) := by have hlim := (coreBallot_relative_error_tendsto.comp coreRateTotalLength_tendsto).const_mul 4 simp only [mul_zero, Function.comp_def] at hlim have hxi (s : ℕ) : 0 ≤ virtualPrimeRelativeError (coreBallotScale (coreRateTotalLength s)) := by have hB := coreBallotScale_pos (coreRateTotalLength s) have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) unfold virtualPrimeRelativeError positivity [primeLogOddsErrorConstant_pos] apply squeeze_zero (fun s ↦ by positivity [hxi s]) (fun s ↦ ?_) hlim have hn : (coreRatePrefixLength s : ℝ) ≤ coreRateTotalLength s := by exact_mod_cast (Nat.sub_le (coreRateBlockLength s) (coreRateSuffixLength s)).trans (coreRateBlockLength_le_total s) have hk : (0 : ℝ) < coreRateTotalLength s := by exact_mod_cast coreRateTotalLength_pos s apply (div_le_iff₀ hk).mpr nlinarith [mul_le_mul_of_nonneg_right hn (hxi s)] /-- Every correction is verified for the explicit parameter sequence; no asymptotic hypothesis on the total cost is assumed. -/ theorem coreRateCost_div_tendsto (eta lam : ℝ) : Tendsto (fun s ↦ coreRateCost eta lam s / coreRateTotalLength s) atTop (𝓝 (corePrefixRate lam)) := by have hmain : Tendsto (fun s ↦ ((coreRateBlockCount s : ℝ) * coreRatePrefixLength s * corePrefixRate lam) / coreRateTotalLength s) atTop (𝓝 (corePrefixRate lam)) := by have h := coreRatePrefix_fraction_tendsto.mul_const (corePrefixRate lam) simp only [one_mul] at h apply h.congr' exact Eventually.of_forall fun s ↦ by have hR : (coreRateBlockCount s : ℝ) ≠ 0 := by exact_mod_cast (coreRateBlockCount_pos s).ne' simp only [coreRateTotalLength, Nat.cast_mul] field_simp have hsuffix : Tendsto (fun s ↦ ((coreRateBlockCount s : ℝ) * coreRateSuffixLength s * coreSuffixRate eta lam) / coreRateTotalLength s) atTop (𝓝 0) := by have h := coreRateSuffix_fraction_tendsto.mul_const (coreSuffixRate eta lam) simp only [zero_mul] at h apply h.congr' exact Eventually.of_forall fun s ↦ by have hR : (coreRateBlockCount s : ℝ) ≠ 0 := by exact_mod_cast (coreRateBlockCount_pos s).ne' simp only [coreRateTotalLength, Nat.cast_mul] field_simp have hnorm : Tendsto (fun s ↦ ((coreRateBlockCount s : ℝ) * (3 + log 2 + 2 * log (coreRatePrefixLength s : ℝ))) / coreRateTotalLength s) atTop (𝓝 0) := by have h := (coreRateBlockLength_real_tendsto.const_div_atTop (3 + log 2)).add (coreRate_log_prefix_div_length_tendsto.const_mul 2) simp only [mul_zero, add_zero] at h apply h.congr' exact Eventually.of_forall fun s ↦ by have hR : (coreRateBlockCount s : ℝ) ≠ 0 := by exact_mod_cast (coreRateBlockCount_pos s).ne' have hH : (coreRateBlockLength s : ℝ) ≠ 0 := by exact_mod_cast (coreRateBlockLength_pos s).ne' simp only [coreRateTotalLength, Nat.cast_mul] field_simp have hshift : Tendsto (fun s ↦ (((coreRateHead s + 1 : ℕ) : ℝ) ^ 2 * log 2) / coreRateTotalLength s) atTop (𝓝 0) := by simpa only [zero_mul, div_mul_eq_mul_div] using coreRateHead_square_div_tendsto.mul_const (log 2) have htwo := coreRateTotalLength_real_tendsto.const_div_atTop (2 : ℝ) have hB := coreBallotScale_tendsto.comp coreRateTotalLength_tendsto have hrec := (hB.const_div_atTop (8 * lam * primeLogOddsErrorConstant)).div_atTop coreRateTotalLength_real_tendsto have hsum := ((((((hmain.add hsuffix).add hnorm).add coreRateHeadLoss_div_tendsto).add hshift).add htwo).add hrec).add coreRate_relative_cost_div_tendsto simpa only [coreRateCost, coreMultiBlockCostUpper, coreRateHeadLoss, add_div, add_zero, Function.comp_def] using! hsum /-- The concrete actual block event achieves the prefix ballot exponential rate. -/ theorem coreRate_actual_probability_lower {eta lam eps : ℝ} (heta : 0 < eta) (heta2 : eta ≤ log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (heps : 0 < eps) : ∀ᶠ s : ℕ in atTop, exp (-(corePrefixRate lam + eps) * (coreRateTotalLength s : ℝ)) ≤ coreMultiBlockEventMass (coreBallotShift (coreRateTotalLength s)) (coreBallotScale (coreRateTotalLength s)) eta lam (coreRatePrefixLength s) (coreRateSuffixLength s) (coreRateBlockCount s) := by have hprob := coreRateTotalLength_tendsto.eventually (coreMultiBlockEventMass_eventually_exponential_lower heta heta2 hlam hlam2) filter_upwards [hprob, coreRateLength_eventually_split, coreRateHead_eventually_le_global, (coreRateCost_div_tendsto eta lam).eventually_lt_const (lt_add_of_pos_right _ heps)] with s hp hs hJ hc have hk : (0 : ℝ) < coreRateTotalLength s := by exact_mod_cast coreRateTotalLength_pos s have hc' := (div_lt_iff₀ hk).mp hc calc _ ≤ exp (-coreRateCost eta lam s) := exp_le_exp.mpr (by nlinarith) _ ≤ _ := hp _ _ _ _ _ le_rfl hs.1 ((Nat.sub_le (coreRateBlockLength s) (coreRateSuffixLength s)).trans (coreRateBlockLength_le_total s)) hJ (coreRate_ratio_le_pow_head s) end Erdos859Verification end /- Inlined development module: FordStoppingPrime.lean -/ section /- Exact stopping-prime localization under the finite prime-pattern law. -/ namespace Erdos859Verification open Finset Real MeasureTheory open scoped Classical def fordPrimePrefix (P : Finset ℕ) (p : ℕ) : Finset ℕ := P.filter (fun q ↦ q < p) def FordRadicalDivisorEvent (y : ℝ) (T : Finset ℕ) : Prop := ∃ U ⊆ T, y < ∏ q ∈ U, (q : ℝ) ∧ (∏ q ∈ U, (q : ℝ)) ≤ 2*y def FordStoppingWitness (y : ℝ) (p : ℕ) (S : Finset ℕ) : Prop := ∃ U ⊆ S, y < (p : ℝ) * ∏ q ∈ U, (q : ℝ) ∧ (p : ℝ) * (∏ q ∈ U, (q : ℝ)) ≤ 2*y /-- Select the largest prime of the witnessing subset; the prefix retains all selected smaller primes, including those not used by this witness. -/ theorem radical_event_stopping_witness {P T : Finset ℕ} (hTP : T ⊆ P) {y : ℝ} (hy : 1 ≤ y) (h : FordRadicalDivisorEvent y T) : ∃ p ∈ P, p ∈ T ∧ FordStoppingWitness y p (T ∩ fordPrimePrefix P p) := by obtain ⟨U, hUT, hlo, hhi⟩ := h have hUne : U.Nonempty := by by_contra he have he := not_nonempty_iff_eq_empty.mp he simp only [he, prod_empty] at hlo linarith let p := U.max' hUne have hpU : p ∈ U := max'_mem U hUne have hpT : p ∈ T := hUT hpU refine ⟨p, hTP hpT, hpT, U.erase p, ?_, ?_, ?_⟩ · intro q hq obtain ⟨hqp, hqU⟩ := mem_erase.mp hq have hqp' : q < p := lt_of_le_of_ne (le_max' U q hqU) hqp exact mem_inter.mpr ⟨hUT hqU, mem_filter.mpr ⟨hTP (hUT hqU), hqp'⟩⟩ · rwa [mul_prod_erase U (fun q : ℕ ↦ (q : ℝ)) hpU] · rwa [mul_prod_erase U (fun q : ℕ ↦ (q : ℝ)) hpU] theorem primePattern_expectation_restrict {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) (F : Finset ℕ → ℝ) : (∑ T ∈ P.powerset, primePatternWeight P T * F (T ∩ B)) = ∑ U ∈ B.powerset, primePatternWeight B U * F U := by simpa only [primeTiltWeight, primeTiltNormalizer, sub_self, zero_div, add_zero, prod_const_one, one_pow, mul_one, div_one] using prime_tilt_expectation_restrict hP hB (by norm_num : (0 : ℝ) < 1) F theorem primePatternWeight_insert_selected {Q S : Finset ℕ} {p : ℕ} (hpQ : p ∉ Q) : primePatternWeight (insert p Q) (insert p S) = (1 / (p : ℝ)) * primePatternWeight Q S := by unfold primePatternWeight rw [prod_insert hpQ] simp only [mem_insert_self, if_true] congr 1 apply prod_congr rfl intro q hq have hqp : q ≠ p := fun he ↦ hpQ (he ▸ hq) simp only [mem_insert, hqp, false_or] /-- The coordinates above the stopping prime integrate out exactly. -/ theorem primePattern_selected_prefix_expectation {P Q : Finset ℕ} {p : ℕ} (hP : ∀ q ∈ P, q.Prime) (hQ : Q ⊆ P) (hpP : p ∈ P) (hpQ : p ∉ Q) (F : Finset ℕ → ℝ) : (∑ T ∈ P.powerset, primePatternWeight P T * (if p ∈ T then F (T ∩ Q) else 0)) = (1 / (p : ℝ)) * ∑ S ∈ Q.powerset, primePatternWeight Q S * F S := by have hBQ : Q ⊆ insert p Q := subset_insert _ _ have hr := primePattern_expectation_restrict hP (insert_subset hpP hQ) (fun T ↦ if p ∈ T then F (T ∩ Q) else 0) have hint (T : Finset ℕ) : (T ∩ insert p Q) ∩ Q = T ∩ Q := by ext q simp only [mem_inter] exact ⟨fun h ↦ ⟨h.1.1, h.2⟩, fun h ↦ ⟨⟨h.1, hBQ h.2⟩, h.2⟩⟩ simp only [mem_inter, mem_insert_self, and_true, hint] at hr rw [hr, sum_powerset_insert hpQ] have hzero : (∑ S ∈ Q.powerset, primePatternWeight (insert p Q) S * (if p ∈ S then F (S ∩ Q) else 0)) = 0 := by apply sum_eq_zero intro S hS have hpS : p ∉ S := fun hp ↦ hpQ ((mem_powerset.mp hS) hp) simp only [if_neg hpS, mul_zero] rw [hzero, zero_add, mul_sum] apply sum_congr rfl intro S hS have hSQ : S ⊆ Q := mem_powerset.mp hS have hinter : insert p S ∩ Q = S := by ext q simp only [mem_inter, mem_insert] constructor · rintro ⟨rfl | hq, hqQ⟩ · exact (hpQ hqQ).elim · exact hq · intro hq exact ⟨Or.inr hq, hSQ hq⟩ rw [if_pos (mem_insert_self p S), hinter, primePatternWeight_insert_selected hpQ] ring theorem primePattern_stopping_witness_mass {P : Finset ℕ} (hP : ∀ q ∈ P, q.Prime) {p : ℕ} (hpP : p ∈ P) (y : ℝ) : (∑ T ∈ P.powerset.filter (fun T ↦ p ∈ T ∧ FordStoppingWitness y p (T ∩ fordPrimePrefix P p)), primePatternWeight P T) = (1 / (p : ℝ)) * primePatternWeight (fordPrimePrefix P p) ∅ * ∑ S ∈ (fordPrimePrefix P p).powerset.filter (FordStoppingWitness y p), primeOddsWeight S := by have hpQ : p ∉ fordPrimePrefix P p := by simp [fordPrimePrefix] have hQ : fordPrimePrefix P p ⊆ P := filter_subset _ _ have h := primePattern_selected_prefix_expectation hP hQ hpP hpQ (fun S ↦ if FordStoppingWitness y p S then 1 else 0) have hleft : (∑ T ∈ P.powerset.filter (fun T ↦ p ∈ T ∧ FordStoppingWitness y p (T ∩ fordPrimePrefix P p)), primePatternWeight P T) = ∑ T ∈ P.powerset, primePatternWeight P T * (if p ∈ T then (if FordStoppingWitness y p (T ∩ fordPrimePrefix P p) then 1 else 0) else 0) := by rw [sum_filter] apply sum_congr rfl intro T _ split_ifs <;> simp_all rw [hleft, h] simp only [mul_ite, mul_one, mul_zero, ← sum_filter] rw [mul_assoc] congr 1 rw [mul_sum] apply sum_congr rfl intro S hS exact primePatternWeight_eq_empty_mul_odds (fun q hq ↦ hP q (hQ hq)) (mem_powerset.mp (mem_filter.mp hS).1) /-- A union bound over actual witnessing largest primes. No conditional independence or localization estimate is assumed. -/ theorem radical_event_mass_le_stopping_sum {P : Finset ℕ} (hP : ∀ q ∈ P, q.Prime) {y : ℝ} (hy : 1 ≤ y) : (∑ T ∈ P.powerset.filter (FordRadicalDivisorEvent y), primePatternWeight P T) ≤ ∑ p ∈ P, (1 / (p : ℝ)) * primePatternWeight (fordPrimePrefix P p) ∅ * ∑ S ∈ (fordPrimePrefix P p).powerset.filter (FordStoppingWitness y p), primeOddsWeight S := by calc _ ≤ ∑ p ∈ P, ∑ T ∈ P.powerset.filter (fun T ↦ p ∈ T ∧ FordStoppingWitness y p (T ∩ fordPrimePrefix P p)), primePatternWeight P T := by simp only [sum_filter] rw [sum_comm] apply sum_le_sum intro T hT by_cases hgood : FordRadicalDivisorEvent y T · rw [if_pos hgood] obtain ⟨p, hpP, hpT, hw⟩ := radical_event_stopping_witness (mem_powerset.mp hT) hy hgood have h := single_le_sum (f := fun p ↦ if p ∈ T ∧ FordStoppingWitness y p (T ∩ fordPrimePrefix P p) then primePatternWeight P T else 0) (fun _ _ ↦ by split_ifs <;> positivity [primePatternWeight_pos hP T]) hpP simpa only [if_pos (And.intro hpT hw)] using h · rw [if_neg hgood] exact sum_nonneg (fun _ _ ↦ by split_ifs <;> positivity [primePatternWeight_pos hP T]) _ = _ := sum_congr rfl (fun p hp ↦ primePattern_stopping_witness_mass hP hp y) end Erdos859Verification end /- Inlined development module: FordPrimePrefixMertens.lean -/ section /- An actual Mertens nonselection factor for complete finite prime universes. -/ namespace Erdos859Verification open Finset Real def FordCompletePrimeUniverse (P : Finset ℕ) : Prop := ∀ p ∈ P, ∀ q < p, q.Prime → q ∈ P def fordPrimesUpTo (N : ℕ) : Finset ℕ := (range (N+1)).filter Nat.Prime theorem fordPrimesUpTo_prime (N : ℕ) : ∀ p ∈ fordPrimesUpTo N, p.Prime := fun _ hp ↦ (mem_filter.mp hp).2 theorem fordPrimesUpTo_complete (N : ℕ) : FordCompletePrimeUniverse (fordPrimesUpTo N) := by intro p hp q hqp hq exact mem_filter.mpr ⟨mem_range.mpr (hqp.trans (mem_range.mp (mem_filter.mp hp).1)), hq⟩ theorem fordPrimePrefix_eq_all_below {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hcomplete : FordCompletePrimeUniverse P) {p : ℕ} (hp : p ∈ P) : fordPrimePrefix P p = (range p).filter Nat.Prime := by ext q simp only [fordPrimePrefix, mem_filter, mem_range] exact ⟨fun h ↦ ⟨h.2, hP q h.1⟩, fun h ↦ ⟨hcomplete p hp q h.1 h.2, h.1⟩⟩ theorem prime_reciprocal_sum_below {p : ℕ} (hp : p.Prime) : (∑ q ∈ (range p).filter Nat.Prime, 1 / (q : ℝ)) = primeReciprocalSum (p : ℝ) - 1 / (p : ℝ) := by have hset : insert p ((range p).filter Nat.Prime) = (Ioc 0 p).filter Nat.Prime := by ext q simp only [mem_insert, mem_filter, mem_range, mem_Ioc] constructor · rintro (rfl | ⟨hqp, hq⟩) · exact ⟨⟨hp.pos, le_rfl⟩, hp⟩ · exact ⟨⟨hq.pos, hqp.le⟩, hq⟩ · rintro ⟨⟨_, hqp⟩, hq⟩ rcases lt_or_eq_of_le hqp with hlt | heq · exact Or.inr ⟨hlt, hq⟩ · exact Or.inl heq have hpnot : p ∉ (range p).filter Nat.Prime := by simp have hsum := congrArg (fun S : Finset ℕ ↦ ∑ q ∈ S, 1/(q:ℝ)) hset rw [sum_insert hpnot] at hsum unfold primeReciprocalSum simp only [Nat.floor_natCast] linarith noncomputable def fordPrefixMertensConstant : ℝ := exp (-PrimeMertens.M + mertensErrorConstant / log 2 + 1) theorem fordPrefixMertensConstant_pos : 0 < fordPrefixMertensConstant := exp_pos _ /-- Completeness is essential: this is proved for every prime below the stopping prime, rather than postulated for an arbitrary sparse family. -/ theorem primePatternWeight_prefix_empty_upper {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hcomplete : FordCompletePrimeUniverse P) {p : ℕ} (hpP : p ∈ P) : primePatternWeight (fordPrimePrefix P p) ∅ ≤ fordPrefixMertensConstant / log (p : ℝ) := by have hp := hP p hpP have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le have hp0 : (0 : ℝ) < p := by exact_mod_cast hp.pos have hl2 : 0 < log (2 : ℝ) := log_pos (by norm_num) have hlog2 : log 2 ≤ log (p : ℝ) := log_le_log (by norm_num) hp2 have hlp : 0 < log (p : ℝ) := hl2.trans_le hlog2 have hM := (abs_le.mp (primeReciprocalSum_estimate hp2)).1 have herr : mertensErrorConstant / log (p : ℝ) ≤ mertensErrorConstant / log 2 := div_le_div_of_nonneg_left mertensErrorConstant_pos.le hl2 hlog2 have hrecip : 1 / (p : ℝ) ≤ 1 := (div_le_one hp0).mpr (by linarith) have hsum : log (log (p : ℝ)) + PrimeMertens.M - mertensErrorConstant / log 2 - 1 ≤ ∑ q ∈ fordPrimePrefix P p, 1 / (q : ℝ) := by rw [fordPrimePrefix_eq_all_below hP hcomplete hpP, prime_reciprocal_sum_below hp] linarith calc _ ≤ exp (-(∑ q ∈ fordPrimePrefix P p, 1 / (q : ℝ))) := primePatternWeight_empty_le_exp (fun q hq ↦ hP q (mem_filter.mp hq).1) _ ≤ exp (-log (log (p : ℝ)) + (-PrimeMertens.M + mertensErrorConstant / log 2 + 1)) := exp_le_exp.mpr (by linarith) _ = _ := by rw [exp_add, exp_neg, exp_log hlp] unfold fordPrefixMertensConstant ring end Erdos859Verification end /- Inlined development module: FordStoppingGeometry.lean -/ section /- Reflected divisor support and the logarithmic stopping threshold. -/ namespace Erdos859Verification open Finset Real MeasureTheory open scoped Classical theorem finiteIntervalSupport_reflection {ι : Type*} (atom : ι → ℝ) (d t : ℝ) : finiteIntervalSupport (fun i ↦ t - atom i) d = (fun x : ℝ ↦ t+d-x) ⁻¹' finiteIntervalSupport atom d := by ext x simp only [finiteIntervalSupport, Set.mem_iUnion, Set.mem_preimage, Set.mem_Icc] constructor <;> rintro ⟨i, hlo, hhi⟩ <;> exact ⟨i, by constructor <;> linarith⟩ theorem finiteIntervalSupport_reflection_volume {ι : Type*} [Fintype ι] (atom : ι → ℝ) (d t : ℝ) : volume.real (finiteIntervalSupport (fun i ↦ t-atom i) d) = volume.real (finiteIntervalSupport atom d) := by rw [finiteIntervalSupport_reflection, Measure.real, (volume.measurePreserving_sub_left (t+d)).measure_preimage (isCompact_finiteIntervalSupport atom d).measurableSet.nullMeasurableSet] rfl noncomputable def fordStoppingAtom (y : ℝ) (S : Finset ℕ) (U : S.powerset) : ℝ := log y - ∑ q ∈ (U : Finset ℕ), log (q : ℝ) theorem fordStoppingSupport_volume (y : ℝ) (S : Finset ℕ) (d : ℝ) : volume.real (finiteIntervalSupport (fordStoppingAtom y S) d) = volume.real (primeSubsetSumSupport S d) := finiteIntervalSupport_reflection_volume _ _ _ theorem stopping_witness_mem_support {S : Finset ℕ} (hS : ∀ q ∈ S, q.Prime) {p : ℕ} (hp : p.Prime) {y : ℝ} (hy : 0 < y) (hw : FordStoppingWitness y p S) : log (p : ℝ) ∈ finiteIntervalSupport (fordStoppingAtom y S) (log 2) := by obtain ⟨U, hUS, hlo, hhi⟩ := hw have hp0 : (0 : ℝ) < p := by exact_mod_cast hp.pos have hU0 : 0 < ∏ q ∈ U, (q : ℝ) := prod_pos fun q hq ↦ by exact_mod_cast (hS q (hUS hq)).pos have hlogs : log (∏ q ∈ U, (q : ℝ)) = ∑ q ∈ U, log (q : ℝ) := log_prod (fun q hq ↦ by exact_mod_cast (hS q (hUS hq)).ne_zero) have hl := log_lt_log hy hlo have hh := log_le_log (mul_pos hp0 hU0) hhi rw [log_mul hp0.ne' hU0.ne', hlogs] at hl hh rw [log_mul (by norm_num : (2 : ℝ) ≠ 0) hy.ne'] at hh apply Set.mem_iUnion.mpr refine ⟨⟨U, mem_powerset.mpr hUS⟩, ?_⟩ change log y - (∑ q ∈ U, log (q : ℝ)) ≤ log (p : ℝ) ∧ log (p : ℝ) ≤ log y - (∑ q ∈ U, log (q : ℝ)) + log 2 constructor <;> linarith theorem fordLogDenominator_pos {S : Finset ℕ} (hS : ∀ q ∈ S, q.Prime) {y : ℝ} (hy : 1 < y) : 0 < fordLogDenominator y S := by by_cases hne : S.Nonempty · obtain ⟨q, hq⟩ := hne exact (log_pos (by exact_mod_cast (hS q hq).one_lt)).trans_le (fordLogDenominator_mark (Subset.refl S) hS (by linarith) hq) · have hS0 := not_nonempty_iff_eq_empty.mp hne simpa [hS0, fordLogDenominator] using log_pos hy /-- The witness forces both the largest selected smaller prime and `y/A(S)` below `p`. Their sum costs only a factor two inside the logarithm. -/ theorem stopping_witness_denominator_le {P S : Finset ℕ} (hP : ∀ q ∈ P, q.Prime) {p : ℕ} (hpP : p ∈ P) (hSprefix : S ⊆ fordPrimePrefix P p) {y : ℝ} (hy : 0 < y) (hw : FordStoppingWitness y p S) : fordLogDenominator y S ≤ 2 * log (p : ℝ) := by have hSP : S ⊆ P := hSprefix.trans (filter_subset _ _) have hp := hP p hpP have hp0 : (0 : ℝ) < p := by exact_mod_cast hp.pos have hprod0 : 0 < ∏ q ∈ S, (q : ℝ) := prod_pos fun q hq ↦ by exact_mod_cast (hP q (hSP hq)).pos obtain ⟨U, hUS, hlo, _hhi⟩ := hw have hprod : (∏ q ∈ U, (q : ℝ)) ≤ ∏ q ∈ S, (q : ℝ) := prod_le_prod_of_subset_of_one_le hUS (fun q _ ↦ Nat.cast_nonneg q) (fun q hq _ ↦ by exact_mod_cast (hP q (hSP hq)).one_le) have hyquot : y / (∏ q ∈ S, (q : ℝ)) < p := (div_lt_iff₀ hprod0).mpr (hlo.trans_le (mul_le_mul_of_nonneg_left hprod hp0.le)) have hmax : ((S.sup id : ℕ) : ℝ) ≤ p := by exact_mod_cast (Finset.sup_le (fun q hq ↦ (mem_filter.mp (hSprefix hq)).2.le)) have hargpos : 0 < ((S.sup id : ℕ) : ℝ) + y / (∏ q ∈ S, (q : ℝ)) := add_pos_of_nonneg_of_pos (Nat.cast_nonneg _) (div_pos hy hprod0) have hlog2 : log (2 : ℝ) ≤ log (p : ℝ) := log_le_log (by norm_num) (by exact_mod_cast hp.two_le) calc _ ≤ log (2 * (p : ℝ)) := log_le_log hargpos (by linarith) _ = log 2 + log (p : ℝ) := log_mul (by norm_num) hp0.ne' _ ≤ _ := by linarith noncomputable def fordStoppingLogThreshold (y : ℝ) (S : Finset ℕ) : ℝ := max (log 2) (fordLogDenominator y S / 2) theorem stopping_witness_threshold_le {P S : Finset ℕ} (hP : ∀ q ∈ P, q.Prime) {p : ℕ} (hpP : p ∈ P) (hSprefix : S ⊆ fordPrimePrefix P p) {y : ℝ} (hy : 0 < y) (hw : FordStoppingWitness y p S) : fordStoppingLogThreshold y S ≤ log (p : ℝ) := by apply max_le · exact log_le_log (by norm_num) (by exact_mod_cast (hP p hpP).two_le) · linarith [stopping_witness_denominator_le hP hpP hSprefix hy hw] theorem stopping_prime_reciprocal_mass_upper {P S : Finset ℕ} (hP : ∀ q ∈ P, q.Prime) (hSP : S ⊆ P) {y : ℝ} (hy : 0 < y) : (∑ p ∈ P.filter (fun p ↦ S ⊆ fordPrimePrefix P p ∧ FordStoppingWitness y p S), 1/(p:ℝ)) ≤ ((3*log 2+2*mertensErrorConstant+1)/log 2) * volume.real (primeSubsetSumSupport S (log 2)) / fordStoppingLogThreshold y S := by have hsub : P.filter (fun p ↦ S ⊆ fordPrimePrefix P p ∧ FordStoppingWitness y p S) ⊆ P.filter (fun p : ℕ ↦ fordStoppingLogThreshold y S ≤ log (p : ℝ) ∧ log (p : ℝ) ∈ finiteIntervalSupport (fordStoppingAtom y S) (log 2)) := by intro p hp obtain ⟨hpP, hprefix, hw⟩ := mem_filter.mp hp exact mem_filter.mpr ⟨hpP, stopping_witness_threshold_le hP hpP hprefix hy hw, stopping_witness_mem_support (fun q hq ↦ hP q (hSP hq)) (hP p hpP) hy hw⟩ calc _ ≤ ∑ p ∈ P.filter (fun p : ℕ ↦ fordStoppingLogThreshold y S ≤ log (p : ℝ) ∧ log (p : ℝ) ∈ finiteIntervalSupport (fordStoppingAtom y S) (log 2)), 1/(p:ℝ) := sum_le_sum_of_subset_of_nonneg hsub (fun _ _ _ ↦ by positivity) _ ≤ _ := by simpa only [fordStoppingSupport_volume] using prime_finiteIntervalSupport_mass_upper P hP (fordStoppingAtom y S) (v := fordStoppingLogThreshold y S) (le_max_left _ _) (log_pos (by norm_num : (1:ℝ)<2)) end Erdos859Verification end /- Inlined development module: FordStoppingLocalization.lean -/ section /- Actual arithmetic localization for the finite squarefree-radical event. -/ namespace Erdos859Verification open Finset Real MeasureTheory open scoped Classical noncomputable def fordPrimeSupportMassConstant : ℝ := (3*log 2+2*mertensErrorConstant+1)/log 2 theorem fordPrimeSupportMassConstant_pos : 0 < fordPrimeSupportMassConstant := by unfold fordPrimeSupportMassConstant positivity [mertensErrorConstant_pos, log_pos (by norm_num : (1:ℝ)<2)] noncomputable def fordStoppingLocalizationConstant : ℝ := 4 * fordPrefixMertensConstant * fordPrimeSupportMassConstant theorem fordStoppingLocalizationConstant_pos : 0 < fordStoppingLocalizationConstant := by unfold fordStoppingLocalizationConstant positivity [fordPrefixMertensConstant_pos, fordPrimeSupportMassConstant_pos] /-- Reindex actual stopping configurations by their smaller-prime selection. -/ theorem stopping_sum_reindex (P : Finset ℕ) (y : ℝ) (G : ℕ → Finset ℕ → ℝ) : (∑ p ∈ P, ∑ S ∈ (fordPrimePrefix P p).powerset.filter (FordStoppingWitness y p), G p S) = ∑ S ∈ P.powerset, ∑ p ∈ P.filter (fun p ↦ S ⊆ fordPrimePrefix P p ∧ FordStoppingWitness y p S), G p S := by have hfilter (p : ℕ) : (fordPrimePrefix P p).powerset.filter (FordStoppingWitness y p) = P.powerset.filter (fun S ↦ S ⊆ fordPrimePrefix P p ∧ FordStoppingWitness y p S) := by ext S simp only [mem_filter, mem_powerset] exact ⟨fun h ↦ ⟨h.1.trans (filter_subset _ _), h⟩, fun h ↦ h.2⟩ simp_rw [hfilter] simp only [sum_filter] exact sum_comm theorem stopping_prime_weighted_mass_upper {P S : Finset ℕ} (hP : ∀ q ∈ P, q.Prime) (hcomplete : FordCompletePrimeUniverse P) (hSP : S ⊆ P) {y : ℝ} (hy : 2 ≤ y) : (∑ p ∈ P.filter (fun p ↦ S ⊆ fordPrimePrefix P p ∧ FordStoppingWitness y p S), (1/(p:ℝ)) * primePatternWeight (fordPrimePrefix P p) ∅) ≤ fordStoppingLocalizationConstant * volume.real (primeSubsetSumSupport S (log 2)) / fordLogDenominator y S ^ 2 := by let v := fordStoppingLogThreshold y S have hv0 : 0 < v := (log_pos (by norm_num : (1:ℝ)<2)).trans_le (le_max_left _ _) have hD0 : 0 < fordLogDenominator y S := fordLogDenominator_pos (fun q hq ↦ hP q (hSP hq)) (by linarith) have hCv : 0 ≤ fordPrefixMertensConstant / v := by positivity [fordPrefixMertensConstant_pos] have hsingle (p : ℕ) (hp : p ∈ P.filter (fun p ↦ S ⊆ fordPrimePrefix P p ∧ FordStoppingWitness y p S)) : primePatternWeight (fordPrimePrefix P p) ∅ ≤ fordPrefixMertensConstant / v := by obtain ⟨hpP, hprefix, hw⟩ := mem_filter.mp hp exact (primePatternWeight_prefix_empty_upper hP hcomplete hpP).trans (div_le_div_of_nonneg_left fordPrefixMertensConstant_pos.le hv0 (stopping_witness_threshold_le hP hpP hprefix (by linarith) hw)) have hrecip : 1 / v^2 ≤ 4 / fordLogDenominator y S ^ 2 := by apply (div_le_div_iff₀ (pow_pos hv0 2) (pow_pos hD0 2)).mpr have hvD : fordLogDenominator y S / 2 ≤ v := le_max_right _ _ nlinarith [sq_nonneg (2*v-fordLogDenominator y S)] calc _ ≤ ∑ p ∈ P.filter (fun p ↦ S ⊆ fordPrimePrefix P p ∧ FordStoppingWitness y p S), (fordPrefixMertensConstant/v) * (1/(p:ℝ)) := by apply sum_le_sum intro p hp simpa only [mul_comm] using mul_le_mul_of_nonneg_left (hsingle p hp) (by positivity : 0≤1/(p:ℝ)) _ = (fordPrefixMertensConstant/v) * ∑ p ∈ P.filter (fun p ↦ S ⊆ fordPrimePrefix P p ∧ FordStoppingWitness y p S), 1/(p:ℝ) := (mul_sum _ _ _).symm _ ≤ (fordPrefixMertensConstant/v) * (fordPrimeSupportMassConstant * volume.real (primeSubsetSumSupport S (log 2))/v) := mul_le_mul_of_nonneg_left (stopping_prime_reciprocal_mass_upper hP hSP (by linarith)) hCv _ = (fordPrefixMertensConstant * fordPrimeSupportMassConstant * volume.real (primeSubsetSumSupport S (log 2))) * (1/v^2) := by ring _ ≤ (fordPrefixMertensConstant * fordPrimeSupportMassConstant * volume.real (primeSubsetSumSupport S (log 2))) * (4/fordLogDenominator y S ^ 2) := mul_le_mul_of_nonneg_left hrecip (by positivity [fordPrefixMertensConstant_pos, fordPrimeSupportMassConstant_pos]) _ = _ := by unfold fordStoppingLocalizationConstant; ring /-- The squarefree-radical event obeys Ford localization with an explicit absolute constant. Both its probability law and prime-window factors have been derived, not supplied as assumptions. -/ theorem radical_event_mass_le_support_denominator {P : Finset ℕ} (hP : ∀ q ∈ P, q.Prime) (hcomplete : FordCompletePrimeUniverse P) {y : ℝ} (hy : 2 ≤ y) : (∑ T ∈ P.powerset.filter (FordRadicalDivisorEvent y), primePatternWeight P T) ≤ fordStoppingLocalizationConstant * ∑ S ∈ P.powerset, primeOddsWeight S * volume.real (primeSubsetSumSupport S (log 2)) / fordLogDenominator y S ^ 2 := by have hreindex : (∑ p ∈ P, (1/(p:ℝ)) * primePatternWeight (fordPrimePrefix P p) ∅ * ∑ S ∈ (fordPrimePrefix P p).powerset.filter (FordStoppingWitness y p), primeOddsWeight S) = ∑ S ∈ P.powerset, primeOddsWeight S * ∑ p ∈ P.filter (fun p ↦ S ⊆ fordPrimePrefix P p ∧ FordStoppingWitness y p S), (1/(p:ℝ)) * primePatternWeight (fordPrimePrefix P p) ∅ := by simp_rw [mul_sum] rw [stopping_sum_reindex] apply sum_congr rfl intro S _ apply sum_congr rfl intro p _ ring calc _ ≤ _ := radical_event_mass_le_stopping_sum hP (by linarith) _ = _ := hreindex _ ≤ ∑ S ∈ P.powerset, primeOddsWeight S * (fordStoppingLocalizationConstant * volume.real (primeSubsetSumSupport S (log 2)) / fordLogDenominator y S ^ 2) := by apply sum_le_sum intro S hS have hSP := mem_powerset.mp hS have hw : 0 ≤ primeOddsWeight S := prod_nonneg (fun q hq ↦ by have hq1 : (1:ℝ) ring exact (radical_event_mass_floor_cutoff_upper hy).trans (mul_le_mul_of_nonneg_left hsupport (div_nonneg fordRadicalSupportConstant_pos.le (sq_nonneg _))) end Erdos859Verification end /- Inlined development module: FordRadicalDecay.lean -/ section /- The radical-divisor event has a vanishing critical-power normalization. -/ open Real Filter open scoped Topology namespace Erdos859Verification noncomputable def fordDecayExponent : ℝ := 2 - fordUpperExponent theorem fordDecayExponent_pos : 0 < fordDecayExponent := by have hl : 0 < log (2 : ℝ) := log_pos (by norm_num) have hlt : log (2 : ℝ) < 1 := by linarith [log_two_lt_d9] have hlog := log_lt_sub_one_of_pos hl hlt.ne unfold fordDecayExponent rw [fordUpperExponent_eq] have hdiv : (1 + log (log 2)) / log 2 < 1 := (div_lt_one hl).mpr (by linarith) linarith theorem fordDecayExponent_eq : fordDecayExponent = 1 - (1 + log (log 2)) / log 2 := by unfold fordDecayExponent rw [fordUpperExponent_eq] ring theorem ford_critical_scaling_identity {x : ℝ} (hx : 0 < x) (L K a B : ℝ) : x ^ fordDecayExponent * (K / x ^ 2) * (a + B * x ^ fordUpperExponent / L ^ (5 / 4 : ℝ)) = K * (a * x ^ (-fordUpperExponent) + B / L ^ (5 / 4 : ℝ)) := by have hpow : x ^ fordDecayExponent / x ^ (2 : ℕ) = x ^ (-fordUpperExponent) := by rw [← rpow_natCast x 2, ← rpow_sub hx] congr 1 unfold fordDecayExponent norm_num have hcancel : x ^ (-fordUpperExponent) * x ^ fordUpperExponent = 1 := by rw [← rpow_add hx, neg_add_cancel, rpow_zero] calc _ = K * (a * (x ^ fordDecayExponent / x ^ (2 : ℕ)) + B * ((x ^ fordDecayExponent / x ^ (2 : ℕ)) * x ^ fordUpperExponent) / L ^ (5 / 4 : ℝ)) := by ring _ = _ := by rw [hpow, hcancel, mul_one] theorem fordRadicalMass_scaled_tendsto_zero : Tendsto (fun y : ℝ ↦ (log (2 * y)) ^ fordDecayExponent * fordRadicalMass y) atTop (𝓝 0) := by have hdouble : Tendsto (fun y : ℝ ↦ 2 * y) atTop atTop := tendsto_id.const_mul_atTop (by norm_num) have hlog : Tendsto (fun y : ℝ ↦ log (2 * y)) atTop atTop := tendsto_log_atTop.comp hdouble have hloglog : Tendsto (fun y : ℝ ↦ log (log (2 * y))) atTop atTop := tendsto_log_atTop.comp hlog have hfirst := ((tendsto_rpow_neg_atTop fordUpperExponent_pos).comp hlog).const_mul (2 * log 2) have hsecond := (((tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 5 / 4)).comp hloglog).inv_tendsto_atTop).const_mul fordRadicalNumeratorConstant have hupper : Tendsto (fun y : ℝ ↦ fordRadicalSupportConstant * (2 * log 2 * (log (2 * y)) ^ (-fordUpperExponent) + fordRadicalNumeratorConstant / (log (log (2 * y))) ^ (5 / 4 : ℝ))) atTop (𝓝 0) := by simpa only [mul_zero, add_zero, div_eq_mul_inv, Function.comp_apply, Pi.inv_apply] using (hfirst.add hsecond).const_mul fordRadicalSupportConstant apply squeeze_zero' _ _ hupper · filter_upwards [eventually_ge_atTop 2] with y hy exact mul_nonneg (rpow_nonneg (log_nonneg (by linarith : 1 ≤ 2 * y)) _) (fordRadicalMass_nonneg y) · filter_upwards [fordRadicalMass_eventual_upper, eventually_ge_atTop 2] with y hy hy2 have hx : 0 < log (2 * y) := log_pos (by linarith) have hm := mul_le_mul_of_nonneg_left hy (rpow_nonneg hx.le fordDecayExponent) simpa only [← mul_assoc, ford_critical_scaling_identity hx] using hm end Erdos859Verification end /- Inlined development module: FordDivisorQuarterBound.lean -/ section /- An elementary uniform quarter-power divisor bound, with an explicit constant. -/ open Finset Real namespace Erdos859Verification theorem ford_exponent_divisor_bound (e : ℕ) : ((e : ℝ) + 1) ^ 4 ≤ 768 * (2 : ℝ) ^ e := by have hlog : (1 / 2 : ℝ) ≤ log 2 := by linarith [log_two_gt_d9] have h := pow_div_factorial_le_exp (((e : ℝ) + 1) * log 2) (by positivity) 4 have he : exp (((e : ℝ) + 1) * log 2) = (2 : ℝ) ^ (e + 1) := by rw [show ((e : ℝ) + 1) = ((e + 1 : ℕ) : ℝ) by push_cast; rfl, exp_nat_mul, exp_log (by norm_num)] rw [he] at h norm_num only [Nat.factorial, Nat.cast_ofNat, mul_pow, pow_succ] at h have hpow := pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 1 / 2) hlog 4 have hm := mul_le_mul_of_nonneg_left hpow (pow_nonneg (by positivity : (0 : ℝ) ≤ e + 1) 4) norm_num at hm nlinarith theorem ford_large_prime_exponent_divisor_bound {p : ℕ} (hp : 16 ≤ p) (e : ℕ) : ((e : ℝ) + 1) ^ 4 ≤ (p : ℝ) ^ e := by have h : (e : ℝ) + 1 ≤ (2 : ℝ) ^ e := by induction e with | zero => norm_num | succ e ih => push_cast rw [pow_succ] nlinarith [Nat.cast_nonneg (α := ℝ) e] calc _ ≤ ((2 : ℝ) ^ e) ^ 4 := pow_le_pow_left₀ (by positivity) h 4 _ = (16 : ℝ) ^ e := by rw [← pow_mul, mul_comm e 4, pow_mul]; norm_num _ ≤ _ := pow_le_pow_left₀ (by norm_num) (by exact_mod_cast hp) e theorem ford_card_divisors_fourth_bound {n : ℕ} (hn : n ≠ 0) : (n.divisors.card : ℝ) ^ 4 ≤ (768 : ℝ) ^ 16 * n := by classical have hprod : (∏ p ∈ n.primeFactors, (p : ℝ) ^ n.factorization p) = (n : ℝ) := by exact_mod_cast (Nat.prod_primeFactors_pow_factorization hn).symm have hsmall : (n.primeFactors.filter fun p ↦ p < 16).card ≤ 16 := by simpa only [card_range] using card_le_card (show (n.primeFactors.filter fun p ↦ p < 16) ⊆ range 16 from fun p hp ↦ mem_range.mpr (mem_filter.mp hp).2) calc _ = ∏ p ∈ n.primeFactors, ((n.factorization p : ℝ) + 1) ^ 4 := by rw [Nat.card_divisors hn, Nat.cast_prod, ← prod_pow] simp only [Nat.cast_add, Nat.cast_one] _ ≤ ∏ p ∈ n.primeFactors, (if p < 16 then (768 : ℝ) else 1) * (p : ℝ) ^ n.factorization p := by apply prod_le_prod (fun _ _ ↦ by positivity) intro p hp by_cases hp16 : p < 16 · rw [if_pos hp16] apply (ford_exponent_divisor_bound _).trans apply mul_le_mul_of_nonneg_left _ (by norm_num) exact pow_le_pow_left₀ (by norm_num) (by exact_mod_cast (Nat.prime_of_mem_primeFactors hp).two_le) _ · rw [if_neg hp16, one_mul] exact ford_large_prime_exponent_divisor_bound (le_of_not_gt hp16) _ _ = (768 : ℝ) ^ (n.primeFactors.filter fun p ↦ p < 16).card * n := by rw [prod_mul_distrib, hprod] congr 1 rw [prod_ite] simp _ ≤ _ := mul_le_mul_of_nonneg_right (pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 768) hsmall) (Nat.cast_nonneg n) theorem ford_card_divisors_quarter_bound (n : ℕ) : (n.divisors.card : ℝ) ≤ (768 : ℝ) ^ 4 * (n : ℝ) ^ (1 / 4 : ℝ) := by by_cases hn : n = 0 · subst n simp · apply le_of_pow_le_pow_left₀ (show (4 : ℕ) ≠ 0 by norm_num) (by positivity) have he : ((n : ℝ) ^ (1 / 4 : ℝ)) ^ 4 = (n : ℝ) := by rw [← rpow_natCast, ← rpow_mul (Nat.cast_nonneg n)] norm_num rw [mul_pow, he, ← pow_mul] exact ford_card_divisors_fourth_bound hn end Erdos859Verification end /- Inlined development module: FordPowerfulTail.lean -/ section /- Summability and a polynomial tail for actual powerful integers. -/ open Finset Real namespace Erdos859Verification def FordPowerful (n : ℕ) : Prop := n ≠ 0 ∧ ∀ p : ℕ, n.factorization p ≠ 1 theorem fordPowerful_iff_prime_square_dvd (n : ℕ) : FordPowerful n ↔ n ≠ 0 ∧ ∀ p : ℕ, p.Prime → p ∣ n → p ^ 2 ∣ n := by constructor · intro hn refine ⟨hn.1, ?_⟩ intro p hp hpn apply (hp.pow_dvd_iff_le_factorization hn.1).mpr have hpos := hp.factorization_pos_of_dvd hn.1 hpn have hne := hn.2 p omega · rintro ⟨hn, h⟩ refine ⟨hn, ?_⟩ intro p he have hp : p.Prime := by by_contra hnot have hz := Nat.factorization_eq_zero_of_not_prime n hnot omega have hpn : p ∣ n := by by_contra hnot have hz := Nat.factorization_eq_zero_of_not_dvd hnot omega have htwo := (hp.pow_dvd_iff_le_factorization hn).mp (h p hp hpn) omega theorem fordPowerful_one : FordPowerful 1 := by simp [FordPowerful] def fordPowerfulSquare (n : ℕ) : ℕ := ∏ p ∈ n.primeFactors, p ^ (n.factorization p / 2 - n.factorization p % 2) def fordPowerfulCube (n : ℕ) : ℕ := ∏ p ∈ n.primeFactors, p ^ (n.factorization p % 2) theorem ford_powerful_exponent (e : ℕ) (he : e ≠ 1) : (e / 2 - e % 2) * 2 + (e % 2) * 3 = e := by omega theorem fordPowerful_representation {n : ℕ} (hn : FordPowerful n) : n = fordPowerfulSquare n ^ 2 * fordPowerfulCube n ^ 3 := by nth_rw 1 [Nat.prod_primeFactors_pow_factorization hn.1] change (∏ p ∈ n.primeFactors, p ^ n.factorization p) = (∏ p ∈ n.primeFactors, p ^ (n.factorization p / 2 - n.factorization p % 2)) ^ 2 * (∏ p ∈ n.primeFactors, p ^ (n.factorization p % 2)) ^ 3 rw [← prod_pow, ← prod_pow, ← prod_mul_distrib] apply prod_congr rfl intro p _ rw [← pow_mul, ← pow_mul, ← pow_add, ford_powerful_exponent _ (hn.2 p)] theorem fordPowerfulSquare_pos (n : ℕ) : 0 < fordPowerfulSquare n := by apply prod_pos intro p hp exact pow_pos (Nat.prime_of_mem_primeFactors hp).pos _ theorem fordPowerfulCube_pos (n : ℕ) : 0 < fordPowerfulCube n := by apply prod_pos intro p hp exact pow_pos (Nat.prime_of_mem_primeFactors hp).pos _ def fordPowerfulPair (n : {n : ℕ // FordPowerful n}) : ℕ × ℕ := (fordPowerfulSquare n.val, fordPowerfulCube n.val) theorem fordPowerfulPair_injective : Function.Injective fordPowerfulPair := by intro n m h apply Subtype.ext have h1 := congrArg Prod.fst h have h2 := congrArg Prod.snd h change fordPowerfulSquare n.val = fordPowerfulSquare m.val at h1 change fordPowerfulCube n.val = fordPowerfulCube m.val at h2 calc n.val = fordPowerfulSquare n.val ^ 2 * fordPowerfulCube n.val ^ 3 := fordPowerful_representation n.property _ = fordPowerfulSquare m.val ^ 2 * fordPowerfulCube m.val ^ 3 := by rw [h1, h2] _ = m.val := (fordPowerful_representation m.property).symm theorem ford_powerful_rpow_summable : Summable (fun n : {n : ℕ // FordPowerful n} ↦ (n.val : ℝ) ^ (-3 / 4 : ℝ)) := by have hr : Summable (fun r : ℕ ↦ (r : ℝ) ^ (-3 / 2 : ℝ)) := summable_nat_rpow.mpr (by norm_num) have hs : Summable (fun s : ℕ ↦ (s : ℝ) ^ (-9 / 4 : ℝ)) := summable_nat_rpow.mpr (by norm_num) have hpair := hr.mul_of_nonneg hs (fun _ ↦ by positivity) (fun _ ↦ by positivity) have hcomp := hpair.comp_injective fordPowerfulPair_injective apply hcomp.congr intro n change (fordPowerfulSquare n.val : ℝ) ^ (-3 / 2 : ℝ) * (fordPowerfulCube n.val : ℝ) ^ (-9 / 4 : ℝ) = (n.val : ℝ) ^ (-3 / 4 : ℝ) have he : (n.val : ℝ) = (fordPowerfulSquare n.val : ℝ) ^ 2 * (fordPowerfulCube n.val : ℝ) ^ 3 := by exact_mod_cast fordPowerful_representation n.property rw [he, mul_rpow (by positivity) (by positivity), ← rpow_natCast_mul (Nat.cast_nonneg _), ← rpow_natCast_mul (Nat.cast_nonneg _)] norm_num theorem ford_powerful_indicator_rpow_summable : Summable (fun n : ℕ ↦ if FordPowerful n then (n : ℝ) ^ (-3 / 4 : ℝ) else 0) := by classical have h := (summable_subtype_iff_indicator (s := {n : ℕ | FordPowerful n}) (f := fun n : ℕ ↦ (n : ℝ) ^ (-3 / 4 : ℝ))).mp ford_powerful_rpow_summable apply h.congr intro n by_cases hn : FordPowerful n · rw [Set.indicator_of_mem (show n ∈ {n : ℕ | FordPowerful n} from hn), if_pos hn] · rw [Set.indicator_of_notMem (show n ∉ {n : ℕ | FordPowerful n} from hn), if_neg hn] theorem ford_divisor_reciprocal_bound {n : ℕ} (hn : n ≠ 0) : (n.divisors.card : ℝ) / n ≤ (768 : ℝ) ^ 4 * (n : ℝ) ^ (-3 / 4 : ℝ) := by have hnR : (0 : ℝ) < n := Nat.cast_pos.mpr (Nat.pos_of_ne_zero hn) calc _ ≤ ((768 : ℝ) ^ 4 * (n : ℝ) ^ (1 / 4 : ℝ)) / n := div_le_div_of_nonneg_right (ford_card_divisors_quarter_bound n) hnR.le _ = _ := by rw [div_eq_mul_inv, ← rpow_neg_one, mul_assoc, ← rpow_add hnR] norm_num theorem ford_powerful_divisor_reciprocal_summable : Summable (fun n : ℕ ↦ if FordPowerful n then (n.divisors.card : ℝ) / n else 0) := by classical apply Summable.of_nonneg_of_le (fun _ ↦ by split_ifs <;> positivity) (fun n ↦ ?_) (ford_powerful_indicator_rpow_summable.mul_left ((768 : ℝ) ^ 4)) by_cases hn : FordPowerful n · simpa only [if_pos hn] using ford_divisor_reciprocal_bound hn.1 · simp only [if_neg hn, mul_zero, le_refl] noncomputable def fordPowerfulTailConstant : ℝ := 1 + ∑' n : ℕ, if FordPowerful n then (n : ℝ) ^ (-3 / 4 : ℝ) else 0 theorem fordPowerfulTailConstant_pos : 0 < fordPowerfulTailConstant := by have h : 0 ≤ ∑' n : ℕ, if FordPowerful n then (n : ℝ) ^ (-3 / 4 : ℝ) else 0 := tsum_nonneg (fun _ ↦ by split_ifs <;> positivity) unfold fordPowerfulTailConstant linarith theorem ford_powerful_rpow_finite_sum_le (T : Finset ℕ) (hT : ∀ n ∈ T, FordPowerful n) : (∑ n ∈ T, (n : ℝ) ^ (-3 / 4 : ℝ)) ≤ fordPowerfulTailConstant := by calc _ = ∑ n ∈ T, if FordPowerful n then (n : ℝ) ^ (-3 / 4 : ℝ) else 0 := by apply sum_congr rfl intro n hn rw [if_pos (hT n hn)] _ ≤ ∑' n : ℕ, if FordPowerful n then (n : ℝ) ^ (-3 / 4 : ℝ) else 0 := ford_powerful_indicator_rpow_summable.sum_le_tsum T (fun _ _ ↦ by split_ifs <;> positivity) _ ≤ _ := by unfold fordPowerfulTailConstant; linarith theorem ford_powerful_divisor_weight_sum_le (T : Finset ℕ) (hT : ∀ n ∈ T, FordPowerful n) : (∑ n ∈ T, (n.divisors.card : ℝ) / n) ≤ (768 : ℝ) ^ 4 * fordPowerfulTailConstant := by calc _ ≤ ∑ n ∈ T, (768 : ℝ) ^ 4 * (n : ℝ) ^ (-3 / 4 : ℝ) := sum_le_sum fun n hn ↦ ford_divisor_reciprocal_bound (hT n hn).1 _ = (768 : ℝ) ^ 4 * ∑ n ∈ T, (n : ℝ) ^ (-3 / 4 : ℝ) := by rw [mul_sum] _ ≤ _ := mul_le_mul_of_nonneg_left (ford_powerful_rpow_finite_sum_le T hT) (by positivity) theorem ford_reciprocal_tail_pointwise {L : ℝ} (hL : 0 < L) {n : ℕ} (hn : L < n) : 1 / (n : ℝ) ≤ L ^ (-1 / 4 : ℝ) * (n : ℝ) ^ (-3 / 4 : ℝ) := by have hnR : (0 : ℝ) < n := hL.trans hn calc _ = (n : ℝ) ^ (-1 / 4 : ℝ) * (n : ℝ) ^ (-3 / 4 : ℝ) := by rw [← rpow_add hnR] norm_num [rpow_neg_one, one_div] _ ≤ _ := mul_le_mul_of_nonneg_right (rpow_le_rpow_of_nonpos hL hn.le (by norm_num)) (by positivity) /-- A polynomial tail for a finite family of actual powerful integers. -/ theorem ford_powerful_reciprocal_tail_sum_le (T : Finset ℕ) {L : ℝ} (hL : 0 < L) (hT : ∀ n ∈ T, FordPowerful n) : (∑ n ∈ T.filter (fun n : ℕ ↦ L < (n : ℝ)), 1 / (n : ℝ)) ≤ fordPowerfulTailConstant / L ^ (1 / 4 : ℝ) := by calc _ ≤ ∑ n ∈ T.filter (fun n : ℕ ↦ L < (n : ℝ)), L ^ (-1 / 4 : ℝ) * (n : ℝ) ^ (-3 / 4 : ℝ) := sum_le_sum fun n hn ↦ ford_reciprocal_tail_pointwise hL (mem_filter.mp hn).2 _ = L ^ (-1 / 4 : ℝ) * ∑ n ∈ T.filter (fun n : ℕ ↦ L < (n : ℝ)), (n : ℝ) ^ (-3 / 4 : ℝ) := by rw [mul_sum] _ ≤ L ^ (-1 / 4 : ℝ) * fordPowerfulTailConstant := mul_le_mul_of_nonneg_left (ford_powerful_rpow_finite_sum_le _ (fun n hn ↦ hT n (mem_filter.mp hn).1)) (by positivity) _ = _ := by rw [show (-1 / 4 : ℝ) = -(1 / 4 : ℝ) by ring, rpow_neg hL.le]; ring theorem ford_powerful_reciprocal_tail_summable {L : ℝ} (hL : 0 < L) : Summable (fun n : ℕ ↦ if FordPowerful n ∧ L < (n : ℝ) then 1 / (n : ℝ) else 0) := by apply Summable.of_nonneg_of_le (fun _ ↦ by split_ifs <;> positivity) (fun n ↦ ?_) (ford_powerful_indicator_rpow_summable.mul_left (L ^ (-1 / 4 : ℝ))) by_cases hn : FordPowerful n ∧ L < (n : ℝ) · simpa only [if_pos hn, if_pos hn.1] using ford_reciprocal_tail_pointwise hL hn.2 · rw [if_neg hn] split_ifs <;> positivity theorem ford_powerful_reciprocal_tail_tsum_le {L : ℝ} (hL : 0 < L) : (∑' n : ℕ, if FordPowerful n ∧ L < (n : ℝ) then 1 / (n : ℝ) else 0) ≤ fordPowerfulTailConstant / L ^ (1 / 4 : ℝ) := by have hpoint (n : ℕ) : (if FordPowerful n ∧ L < (n : ℝ) then 1 / (n : ℝ) else 0) ≤ L ^ (-1 / 4 : ℝ) * (if FordPowerful n then (n : ℝ) ^ (-3 / 4 : ℝ) else 0) := by by_cases hn : FordPowerful n ∧ L < (n : ℝ) · simpa only [if_pos hn, if_pos hn.1] using ford_reciprocal_tail_pointwise hL hn.2 · rw [if_neg hn] split_ifs <;> positivity calc _ ≤ ∑' n : ℕ, L ^ (-1 / 4 : ℝ) * (if FordPowerful n then (n : ℝ) ^ (-3 / 4 : ℝ) else 0) := (ford_powerful_reciprocal_tail_summable hL).tsum_le_tsum hpoint (ford_powerful_indicator_rpow_summable.mul_left _) _ = L ^ (-1 / 4 : ℝ) * ∑' n : ℕ, if FordPowerful n then (n : ℝ) ^ (-3 / 4 : ℝ) else 0 := tsum_mul_left _ ≤ L ^ (-1 / 4 : ℝ) * fordPowerfulTailConstant := mul_le_mul_of_nonneg_left (by unfold fordPowerfulTailConstant; linarith) (by positivity) _ = _ := by rw [show (-1 / 4 : ℝ) = -(1 / 4 : ℝ) by ring, rpow_neg hL.le]; ring end Erdos859Verification end /- Inlined development module: PrimeCappedValuationLaw.lean -/ section /- Exact finite laws of capped prime valuations, derived from divisibility densities. -/ namespace Erdos859Verification open Finset Filter Real open scoped Topology Classical theorem primePowerProduct_dvd_iff {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (e : ℕ → ℕ) (n : ℕ) : (∏ p ∈ P, p ^ e p) ∣ n ↔ ∀ p ∈ P, p ^ e p ∣ n := by induction P using Finset.induction_on with | empty => simp | @insert p P hp ih => have hpprime := hP p (mem_insert_self p P) have hP' : ∀ q ∈ P, q.Prime := fun q hq ↦ hP q (mem_insert_of_mem hq) have hcop : Nat.Coprime (p ^ e p) (∏ q ∈ P, q ^ e q) := by apply Nat.Coprime.prod_right intro q hq apply Nat.Coprime.pow exact (Nat.coprime_primes hpprime (hP' q hq)).mpr (fun he ↦ hp (he ▸ hq)) rw [prod_insert hp] constructor · intro hd q hq rcases mem_insert.mp hq with rfl | hq · exact dvd_trans (dvd_mul_right _ _) hd · exact (ih hP').mp (dvd_trans (dvd_mul_left _ _) hd) q hq · intro hd exact hcop.mul_dvd_of_dvd_of_dvd (hd p (mem_insert_self p P)) ((ih hP').mpr (fun q hq ↦ hd q (mem_insert_of_mem hq))) theorem primePowerProduct_indicator {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (e : ℕ → ℕ) (n : ℕ) : (∏ p ∈ P, if p ^ e p ∣ n then (1:ℝ) else 0) = if (∏ p ∈ P, p ^ e p) ∣ n then 1 else 0 := by by_cases hall : ∀ p ∈ P, p ^ e p ∣ n · rw [if_pos ((primePowerProduct_dvd_iff hP e n).mpr hall)] exact prod_eq_one (fun p hp ↦ if_pos (hall p hp)) · rw [if_neg (mt (primePowerProduct_dvd_iff hP e n).mp hall)] push Not at hall obtain ⟨p, hp, hpn⟩ := hall exact prod_eq_zero hp (if_neg hpn) theorem prod_powerset_choice {P S : Finset ℕ} (hS : S ⊆ P) (f g : ℕ → ℝ) : (∏ p ∈ P, if p ∈ S then f p else g p) = (∏ p ∈ S, f p) * ∏ p ∈ P \ S, g p := by rw [prod_ite] have hyes : P.filter (fun p ↦ p ∈ S) = S := by ext p simp only [mem_filter] exact and_iff_right_of_imp (fun hp ↦ hS hp) have hno : P.filter (fun p ↦ p ∉ S) = P \ S := by ext p; simp rw [hyes, hno] /-- Each coordinate may test either of two prime powers. This exact moment identity supplies capped-valuation independence without assuming it. -/ theorem tendsto_mean_prime_power_choices {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (e f : ℕ → ℕ) (a b : ℕ → ℝ) : Tendsto (fun N : ℕ ↦ (∑ n ∈ range N, ∏ p ∈ P, (a p * (if p ^ e p ∣ n then (1:ℝ) else 0) + b p * (if p ^ f p ∣ n then (1:ℝ) else 0))) / N) atTop (𝓝 (∏ p ∈ P, (a p / (p:ℝ) ^ e p + b p / (p:ℝ) ^ f p))) := by let k : Finset ℕ → ℕ → ℕ := fun S p ↦ if p ∈ S then e p else f p let c : Finset ℕ → ℝ := fun S ↦ ∏ p ∈ P, if p ∈ S then a p else b p have hexpand (n : ℕ) : (∏ p ∈ P, (a p * (if p ^ e p ∣ n then (1:ℝ) else 0) + b p * (if p ^ f p ∣ n then (1:ℝ) else 0))) = ∑ S ∈ P.powerset, c S * (if (∏ p ∈ P, p ^ k S p) ∣ n then 1 else 0) := by rw [prod_add] apply sum_congr rfl intro S hS rw [← primePowerProduct_indicator hP (k S) n] dsimp only [c] rw [← prod_mul_distrib, ← prod_powerset_choice (mem_powerset.mp hS)] apply prod_congr rfl intro p _ dsimp [k] split_ifs <;> rfl have heach : ∀ S ∈ P.powerset, Tendsto (fun N : ℕ ↦ c S * ((∑ n ∈ range N, if (∏ p ∈ P, p ^ k S p) ∣ n then (1:ℝ) else 0) / N)) atTop (𝓝 (c S * (1 / ((∏ p ∈ P, p ^ k S p : ℕ):ℝ)))) := by intro S _ exact (tendsto_mean_dvd_indicator (prod_pos (fun p hp ↦ pow_pos (hP p hp).pos _))).const_mul (c S) have hsum := tendsto_finsetSum P.powerset heach convert hsum using 1 · funext N simp only [hexpand, sum_div, mul_div_assoc, mul_sum] rw [sum_comm] · apply congrArg nhds rw [prod_add] apply sum_congr rfl intro S hS rw [← prod_powerset_choice (mem_powerset.mp hS)] dsimp [c] simp only [Nat.cast_prod, Nat.cast_pow, mul_one_div, ← prod_div_distrib] apply prod_congr rfl intro p _ dsimp [k] split_ifs <;> rfl def PrimeCappedValuationPatternSet (P : Finset ℕ) (cap e : ℕ → ℕ) : Set ℕ := {n | ∀ p ∈ P, p ^ e p ∣ n ∧ (e p < cap p → ¬ p ^ (e p + 1) ∣ n)} noncomputable def cappedPrimeValuationWeight (p cap e : ℕ) : ℝ := if e = cap then 1 / (p:ℝ)^e else (1-1/(p:ℝ)) / (p:ℝ)^e noncomputable def primeCappedPatternWeight (P : Finset ℕ) (cap e : ℕ → ℕ) : ℝ := ∏ p ∈ P, cappedPrimeValuationWeight p (cap p) (e p) theorem cappedPrimeValuationWeight_eq {p c e : ℕ} (hp : p.Prime) (he : e ≤ c) : cappedPrimeValuationWeight p c e = 1/(p:ℝ)^e + (if e by_cases hn : p^(e p+1) ∣ n <;> by_cases hc : e p < cap p <;> simp_all def cappedPrimeValuation (p cap n : ℕ) : ℕ := Nat.findGreatest (fun e ↦ p^e ∣ n) cap theorem cappedPrimeValuation_le (p cap n : ℕ) : cappedPrimeValuation p cap n ≤ cap := Nat.findGreatest_le cap theorem cappedPrimeValuation_eq_iff (p cap n e : ℕ) (he : e ≤ cap) : cappedPrimeValuation p cap n = e ↔ p^e ∣ n ∧ (e positivity theorem sum_cappedPrimeValuationWeight {p : ℕ} (hp : p.Prime) (cap : ℕ) : (∑ e ∈ range (cap+1), cappedPrimeValuationWeight p cap e) = 1 := by have htel (c : ℕ) : (∑ e ∈ range c, (1/(p:ℝ)^e - 1/(p:ℝ)^(e+1))) = 1-1/(p:ℝ)^c := by induction c with | zero => simp | succ c ih => rw [sum_range_succ, ih]; ring rw [sum_range_succ] have hsum : (∑ e ∈ range cap, cappedPrimeValuationWeight p cap e) = ∑ e ∈ range cap, (1/(p:ℝ)^e - 1/(p:ℝ)^(e+1)) := by apply sum_congr rfl intro e he have hec := mem_range.mp he rw [cappedPrimeValuationWeight_eq hp hec.le, if_pos hec] ring rw [hsum, htel] simp [cappedPrimeValuationWeight] end Erdos859Verification end /- Inlined development module: FiniteBernoulliDomination.lean -/ section /- Coordinatewise stochastic domination for exact finite subset laws. -/ namespace Erdos859Verification open Finset open scoped Classical noncomputable def finiteBernoulliSubsetWeight (P : Finset ℕ) (r : ℕ → ℝ) (T : Finset ℕ) : ℝ := ∏ p ∈ P, if p ∈ T then r p else 1-r p noncomputable def bernoulliSubsetMean (P : Finset ℕ) (r : ℕ → ℝ) (f : Finset ℕ → ℝ) : ℝ := ∑ T ∈ P.powerset, finiteBernoulliSubsetWeight P r T * f T theorem finiteBernoulliSubsetWeight_nonneg {P : Finset ℕ} {r : ℕ → ℝ} (hr : ∀ p ∈ P, 0 ≤ r p ∧ r p ≤ 1) (T : Finset ℕ) : 0 ≤ finiteBernoulliSubsetWeight P r T := by apply prod_nonneg intro p hp split_ifs · exact (hr p hp).1 · exact sub_nonneg.mpr (hr p hp).2 theorem bernoulliSubsetMean_mono_observable {P : Finset ℕ} {r : ℕ → ℝ} (hr : ∀ p ∈ P, 0 ≤ r p ∧ r p ≤ 1) {f g : Finset ℕ → ℝ} (hfg : ∀ T ⊆ P, f T ≤ g T) : bernoulliSubsetMean P r f ≤ bernoulliSubsetMean P r g := sum_le_sum (fun T hT ↦ mul_le_mul_of_nonneg_left (hfg T (mem_powerset.mp hT)) (finiteBernoulliSubsetWeight_nonneg hr T)) theorem finiteBernoulliSubsetWeight_insert {P S : Finset ℕ} {p : ℕ} (hp : p ∉ P) (hS : S ⊆ P) (r : ℕ → ℝ) : finiteBernoulliSubsetWeight (insert p P) r S = (1-r p)*finiteBernoulliSubsetWeight P r S ∧ finiteBernoulliSubsetWeight (insert p P) r (insert p S) = r p*finiteBernoulliSubsetWeight P r S := by have hpS : p ∉ S := fun h ↦ hp (hS h) constructor · simp only [finiteBernoulliSubsetWeight, prod_insert hp, if_neg hpS] · unfold finiteBernoulliSubsetWeight rw [prod_insert hp] simp only [mem_insert_self, if_true] congr 1 apply prod_congr rfl intro q hq have hqp : q ≠ p := fun he ↦ hp (he ▸ hq) simp only [mem_insert, hqp, false_or] theorem bernoulliSubsetMean_insert {P : Finset ℕ} {p : ℕ} (hp : p ∉ P) (r : ℕ → ℝ) (f : Finset ℕ → ℝ) : bernoulliSubsetMean (insert p P) r f = (1-r p)*bernoulliSubsetMean P r f + r p*bernoulliSubsetMean P r (fun T ↦ f (insert p T)) := by unfold bernoulliSubsetMean rw [sum_powerset_insert hp, mul_sum, mul_sum] congr 1 · apply sum_congr rfl intro T hT rw [(finiteBernoulliSubsetWeight_insert hp (mem_powerset.mp hT) r).1] ring · apply sum_congr rfl intro T hT rw [(finiteBernoulliSubsetWeight_insert hp (mem_powerset.mp hT) r).2] ring theorem sum_finiteBernoulliSubsetWeight (P : Finset ℕ) (r : ℕ → ℝ) : ∑ T ∈ P.powerset, finiteBernoulliSubsetWeight P r T = 1 := by suffices bernoulliSubsetMean P r (fun _ ↦ 1) = 1 by simpa [bernoulliSubsetMean] using this induction P using Finset.induction_on with | empty => simp [bernoulliSubsetMean, finiteBernoulliSubsetWeight] | @insert p P hp ih => rw [bernoulliSubsetMean_insert hp, ih]; ring /-- Raising independent selection probabilities increases every monotone observable. The proof eliminates one actual finite coordinate at a time. -/ theorem bernoulliSubsetMean_mono_parameters (P : Finset ℕ) (r s : ℕ → ℝ) (hr : ∀ p ∈ P, 0 ≤ r p) (hrs : ∀ p ∈ P, r p ≤ s p) (hs : ∀ p ∈ P, s p ≤ 1) (f : Finset ℕ → ℝ) (hf : Monotone f) : bernoulliSubsetMean P r f ≤ bernoulliSubsetMean P s f := by induction P using Finset.induction_on generalizing f with | empty => simp [bernoulliSubsetMean, finiteBernoulliSubsetWeight] | @insert p P hp ih => have hrP : ∀ q ∈ P, 0 ≤ r q := fun q hq ↦ hr q (mem_insert_of_mem hq) have hrsP : ∀ q ∈ P, r q ≤ s q := fun q hq ↦ hrs q (mem_insert_of_mem hq) have hsP : ∀ q ∈ P, s q ≤ 1 := fun q hq ↦ hs q (mem_insert_of_mem hq) have hrp := hr p (mem_insert_self p P) have hrsp := hrs p (mem_insert_self p P) have hsp := hs p (mem_insert_self p P) have h0 := ih hrP hrsP hsP f hf have h1 := ih hrP hrsP hsP (fun T ↦ f (insert p T)) (fun A B hAB ↦ hf (insert_subset_insert p hAB)) have hstep : bernoulliSubsetMean P s f ≤ bernoulliSubsetMean P s (fun T ↦ f (insert p T)) := bernoulliSubsetMean_mono_observable (fun q hq ↦ ⟨(hrP q hq).trans (hrsP q hq), hsP q hq⟩) (fun T _ ↦ hf (subset_insert p T)) rw [bernoulliSubsetMean_insert hp, bernoulliSubsetMean_insert hp] calc _ ≤ (1-r p)*bernoulliSubsetMean P s f + r p*bernoulliSubsetMean P s (fun T ↦ f (insert p T)) := add_le_add (mul_le_mul_of_nonneg_left h0 (by linarith)) (mul_le_mul_of_nonneg_left h1 hrp) _ ≤ _ := by nlinarith [mul_nonneg (sub_nonneg.mpr hrsp) (sub_nonneg.mpr hstep)] theorem prime_softened_expectation_le {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (f : Finset ℕ → ℝ) (hf : Monotone f) : bernoulliSubsetMean P (fun p ↦ 1/((p:ℝ)+1)) f ≤ ∑ T ∈ P.powerset, primePatternWeight P T * f T := by exact bernoulliSubsetMean_mono_parameters P (fun p ↦ 1/((p:ℝ)+1)) (fun p ↦ 1/(p:ℝ)) (fun p _ ↦ by positivity) (fun p hp ↦ one_div_le_one_div_of_le (by exact_mod_cast (hP p hp).pos) (by linarith)) (fun p hp ↦ (div_le_one (by exact_mod_cast (hP p hp).pos)).mpr (by exact_mod_cast (hP p hp).one_le)) f hf theorem prime_softened_expectation_le_ambient {P Q : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hQ : Q ⊆ P) (f : Finset ℕ → ℝ) (hf : Monotone f) : bernoulliSubsetMean Q (fun p ↦ 1/((p:ℝ)+1)) f ≤ ∑ T ∈ P.powerset, primePatternWeight P T * f T := (prime_softened_expectation_le (fun p hp ↦ hP p (hQ hp)) f hf).trans (prime_expectation_mono_universe hP hQ f hf) end Erdos859Verification end /- Inlined development module: PrimePowerfulConditioning.lean -/ section /- Exact powerful-part conditioning and domination of the remaining squarefree selection. -/ namespace Erdos859Verification open Finset open scoped Classical def powerfulCompletionExponent (H : Finset ℕ) (a : ℕ → ℕ) (T : Finset ℕ) (p : ℕ) : ℕ := if p ∈ H then a p else if p ∈ T then 1 else 0 def powerfulPartNumber (H : Finset ℕ) (a : ℕ → ℕ) : ℕ := ∏ p ∈ H, p ^ a p noncomputable def fixedPowerfulCappedMass (P H : Finset ℕ) (cap a : ℕ → ℕ) : ℝ := (∏ p ∈ H, cappedPrimeValuationWeight p (cap p) (a p)) * ∏ p ∈ P \ H, (1-1/(p:ℝ)^2) theorem cappedPrimeValuationWeight_pos {p : ℕ} (hp : p.Prime) (cap e : ℕ) : 0 < cappedPrimeValuationWeight p cap e := by have hp0 : (0:ℝ)

positivity theorem cappedPrimeValuationWeight_le_power {p : ℕ} (_hp : p.Prime) (cap e : ℕ) : cappedPrimeValuationWeight p cap e ≤ 1/(p:ℝ)^e := by unfold cappedPrimeValuationWeight split_ifs · rfl · exact div_le_div_of_nonneg_right (sub_le_self _ (by positivity)) (by positivity) theorem prime_low_valuation_mass_pos {p : ℕ} (hp : p.Prime) : 0 < 1-1/(p:ℝ)^2 := by have hp1 : (1:ℝ)

first | rfl | ring · have hzero : (∑ p ∈ P.filter (fun p ↦ p ∉ S ∧ RankedImproperExtension A B k H S p), primeTiltSelectionProbability lam p) = 0 := by apply sum_eq_zero intro p hp exact False.elim (hs ⟨(mem_filter.mp hp).2.2.1, (mem_filter.mp hp).2.2.2.1⟩) rw [hzero] change 0 ≤ (2 / A) * exp (-A) * L positivity /-- An explicit absolute error bound in the actual finite tilted-prime law. -/ theorem ranked_improper_certificate_mass_le {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {A B V lam : ℝ} {k H : ℕ} (hA : 0 < A) (hB : 0 < B) (hV : 0 ≤ V) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (hH : 0 < H) (hcap : log ((4 * H + 1 : ℕ) : ℝ) ≤ B) (hlog : ∀ p ∈ P, log (p : ℝ) ≤ V) : (∑ T ∈ P.powerset.filter (PrimeExtensionCertificate P (RankedImproperExtension A B k H)), primeTiltWeight P lam T) ≤ exp (∑ p ∈ P, primeTiltSelectionProbability lam p) * ((2 / A) * exp (-A) * (log ((2 * H : ℕ) : ℝ) + 2 * k * V)) := by apply prime_extension_certificate_mass_le_exp hP (by linarith) _ · have hlog0 : 0 ≤ log ((2 * H : ℕ) : ℝ) := log_nonneg (by exact_mod_cast (show 1 ≤ 2 * H by omega)) positivity · intro S hS exact ranked_improper_extension_weight_le hP (mem_powerset.mp hS) hA hB hV hlam hlam2 hH hcap hlog end Erdos859Verification end /- Inlined development module: CoreProperFailureRate.lean -/ section /- Ranked arithmetic failure certificates are negligible at every exponential rate. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification noncomputable def coreProperCap (k : ℕ) : ℕ := ⌈exp ((k : ℝ) ^ 2)⌉₊ theorem coreProperCap_pos (k : ℕ) : 0 < coreProperCap k := by have h : (0 : ℝ) < coreProperCap k := (exp_pos _).trans_le (Nat.le_ceil _) exact_mod_cast h theorem coreProperCap_log_difference_base_le (k : ℕ) : log ((4 * coreProperCap k + 1 : ℕ) : ℝ) ≤ (k : ℝ) ^ 2 + 8 := by have he : (1 : ℝ) ≤ exp ((k : ℝ) ^ 2) := one_le_exp (sq_nonneg _) have hc : (coreProperCap k : ℝ) ≤ 2 * exp ((k : ℝ) ^ 2) := by have hceil := Nat.ceil_lt_add_one (exp_pos ((k : ℝ) ^ 2)).le change (coreProperCap k : ℝ) < exp ((k : ℝ) ^ 2) + 1 at hceil linarith have hbase : ((4 * coreProperCap k + 1 : ℕ) : ℝ) ≤ 9 * exp ((k : ℝ) ^ 2) := by push_cast linarith have h := log_le_log (by positivity : (0 : ℝ) < ((4 * coreProperCap k + 1 : ℕ) : ℝ)) hbase rw [log_mul (by norm_num) (exp_ne_zero _), log_exp] at h have hnine : log (9 : ℝ) ≤ 8 := by have hl := log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 9) norm_num at hl exact hl linarith theorem coreProperCap_log_size_le (k : ℕ) : log ((2 * coreProperCap k : ℕ) : ℝ) ≤ (k : ℝ) ^ 2 + 2 := by have hc := (log_ceil_exp_bounds (sq_nonneg (k : ℝ))).2 have hcap0 : (0 : ℝ) < coreProperCap k := by exact_mod_cast coreProperCap_pos k have hlog2 : log (2 : ℝ) ≤ 1 := by have h := log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) norm_num at h exact h rw [Nat.cast_mul, Nat.cast_ofNat, log_mul (by norm_num) hcap0.ne'] change log (coreProperCap k : ℝ) ≤ (k : ℝ) ^ 2 + log 2 at hc linarith theorem coreProperCap_scale_admissible {k : ℕ} (hk : 50 ≤ k) : log ((4 * coreProperCap k + 1 : ℕ) : ℝ) ≤ coreBallotScale k := by have hkR : (50 : ℝ) ≤ k := by exact_mod_cast hk apply (coreProperCap_log_difference_base_le k).trans unfold coreBallotScale nlinarith [sq_nonneg ((k : ℝ) - 50)] noncomputable def coreProperFailureError (lam : ℝ) (k : ℕ) : ℝ := exp (lam * k * log 2 + 2 * lam * primeLogOddsErrorConstant / (coreBallotShift k + coreBallotScale k)) * ((2 / coreBallotShift k) * exp (-coreBallotShift k) * (log ((2 * coreProperCap k : ℕ) : ℝ) + 2 * k * (coreBallotShift k + coreBallotScale k * (2 : ℝ) ^ k))) theorem coreProperFailureError_exp_bound {k : ℕ} (hk : 0 < k) {lam : ℝ} (_hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) : coreProperFailureError lam k ≤ exp (log 936 + 4 * primeLogOddsErrorConstant + 4 * (k : ℝ) - 10 * (k : ℝ) ^ 3) := by have hk1 : (1 : ℝ) ≤ k := by exact_mod_cast hk have hk0 : (0 : ℝ) < k := by exact_mod_cast hk have hpow : (1 : ℝ) ≤ 2 ^ k := one_le_pow₀ (by norm_num) have hk23 : (k : ℝ) ^ 2 ≤ (k : ℝ) ^ 3 := by nlinarith [mul_nonneg (sq_nonneg (k : ℝ)) (sub_nonneg.mpr hk1)] have hk24 : (k : ℝ) ^ 2 ≤ (k : ℝ) ^ 4 := by nlinarith [sq_nonneg ((k : ℝ) ^ 2 - 1)] have hA : 0 < coreBallotShift k := by unfold coreBallotShift; positivity have hA2 : 2 ≤ coreBallotShift k := by unfold coreBallotShift; nlinarith have hB := coreBallotScale_pos k have hlog2 : 0 < log (2 : ℝ) := log_pos (by norm_num) have hlog21 : log (2 : ℝ) ≤ 1 := by have h := log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) norm_num at h exact h have hC := primeLogOddsErrorConstant_pos have hBupper : coreBallotScale k ≤ 8 * (k : ℝ) ^ 2 := by unfold coreBallotScale nlinarith have hV : coreBallotShift k + coreBallotScale k * (2 : ℝ) ^ k ≤ 18 * (k : ℝ) ^ 3 * (2 : ℝ) ^ k := by have h1 := mul_le_mul_of_nonneg_left hpow (show 0 ≤ 10 * (k : ℝ) ^ 3 by positivity) have h2 := mul_le_mul_of_nonneg_right hBupper (by positivity : 0 ≤ (2 : ℝ) ^ k) have h3 := mul_le_mul_of_nonneg_right hk23 (by positivity : 0 ≤ 8 * (2 : ℝ) ^ k) unfold coreBallotShift nlinarith have hL : log ((2 * coreProperCap k : ℕ) : ℝ) + 2 * k * (coreBallotShift k + coreBallotScale k * (2 : ℝ) ^ k) ≤ 39 * (k : ℝ) ^ 4 * (2 : ℝ) ^ k := by have h1 := mul_le_mul_of_nonneg_left hV (by positivity : 0 ≤ 2 * (k : ℝ)) have h2 := mul_le_mul_of_nonneg_left hpow (sq_nonneg (k : ℝ)) have h3 := mul_le_mul_of_nonneg_right hk24 (by positivity : 0 ≤ (2 : ℝ) ^ k) nlinarith [coreProperCap_log_size_le k] have htheta : lam * k * log 2 + 2 * lam * primeLogOddsErrorConstant / (coreBallotShift k + coreBallotScale k) ≤ 2 * (k : ℝ) + 4 * primeLogOddsErrorConstant := by have hfirst := mul_le_mul (mul_le_mul_of_nonneg_right hlam2 hk0.le) hlog21 hlog2.le (by positivity : 0 ≤ 2 * (k : ℝ)) have hnum : 2 * lam * primeLogOddsErrorConstant ≤ 4 * primeLogOddsErrorConstant := by nlinarith have hden : 1 ≤ coreBallotShift k + coreBallotScale k := by linarith have hlast : 2 * lam * primeLogOddsErrorConstant / (coreBallotShift k + coreBallotScale k) ≤ 4 * primeLogOddsErrorConstant := by apply (div_le_iff₀ (by positivity)).mpr nlinarith [mul_le_mul_of_nonneg_left hden (show 0 ≤ 4 * primeLogOddsErrorConstant by positivity)] nlinarith have hk4 : (k : ℝ) ^ 4 ≤ 24 * exp (k : ℝ) := by have h := pow_div_factorial_le_exp (k : ℝ) hk0.le 4 norm_num at h linarith have htwopow : (2 : ℝ) ^ k ≤ exp (k : ℝ) := by calc _ = exp ((k : ℝ) * log 2) := by rw [exp_nat_mul, exp_log (by norm_num)] _ ≤ _ := exp_le_exp.mpr (by nlinarith) have hLexp : log ((2 * coreProperCap k : ℕ) : ℝ) + 2 * k * (coreBallotShift k + coreBallotScale k * (2 : ℝ) ^ k) ≤ 936 * exp (2 * (k : ℝ)) := by apply hL.trans calc _ ≤ 39 * (24 * exp (k : ℝ)) * exp (k : ℝ) := by gcongr _ = _ := by rw [show (2 : ℝ) * k = (k : ℝ) + k by ring, exp_add]; ring have hL0 : 0 ≤ log ((2 * coreProperCap k : ℕ) : ℝ) + 2 * k * (coreBallotShift k + coreBallotScale k * (2 : ℝ) ^ k) := by exact add_nonneg (log_natCast_nonneg _) (by positivity) have hsmall : 2 / coreBallotShift k ≤ 1 := (div_le_one hA).mpr hA2 unfold coreProperFailureError calc _ ≤ exp (2 * (k : ℝ) + 4 * primeLogOddsErrorConstant) * (1 * exp (-coreBallotShift k) * (936 * exp (2 * (k : ℝ)))) := by apply mul_le_mul (exp_le_exp.mpr htheta) (mul_le_mul (mul_le_mul_of_nonneg_right hsmall (exp_pos _).le) hLexp hL0 (by positivity)) (by positivity) (exp_pos _).le _ = _ := by rw [show log (936 : ℝ) + 4 * primeLogOddsErrorConstant + 4 * (k : ℝ) - 10 * (k : ℝ) ^ 3 = (2 * (k : ℝ) + 4 * primeLogOddsErrorConstant) + (-coreBallotShift k) + (log 936 + 2 * (k : ℝ)) by unfold coreBallotShift; ring] simp only [exp_add, exp_log (by norm_num : (0 : ℝ) < 936)] ring theorem coreProperFailureError_eventually_exponential {lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (c : ℝ) : ∀ᶠ k : ℕ in atTop, coreProperFailureError lam k ≤ exp (-c * (k : ℝ)) := by have hnat : Tendsto (fun k : ℕ ↦ (k : ℝ)) atTop atTop := tendsto_natCast_atTop_atTop filter_upwards [(tendsto_const_div_atTop_nhds_zero_nat (log (936 : ℝ) + 4 * primeLogOddsErrorConstant)).eventually_lt_const (by norm_num : (0 : ℝ) < 1), hnat.eventually_ge_atTop (c + 5), eventually_gt_atTop 0] with k hconst hc hk have hkR : (1 : ℝ) ≤ k := by exact_mod_cast hk have hkpos : (0 : ℝ) < k := by exact_mod_cast hk have hconst' : log (936 : ℝ) + 4 * primeLogOddsErrorConstant ≤ k := by simpa only [one_mul] using ((div_lt_iff₀ hkpos).mp hconst).le have hk2 : (k : ℝ) ≤ (k : ℝ) ^ 2 := by nlinarith have hc2 : c + 5 ≤ 10 * (k : ℝ) ^ 2 := by nlinarith [sq_nonneg (k : ℝ)] have hc3 := mul_le_mul_of_nonneg_right hc2 hkpos.le exact (coreProperFailureError_exp_bound hk hlam hlam2).trans (exp_le_exp.mpr (by nlinarith)) theorem virtualPrime_ranked_improper_mass_le_error {k : ℕ} (hk : 50 ≤ k) {lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) : (∑ T ∈ (virtualPrimeUniverse (coreBallotShift k) (coreBallotScale k) k).powerset.filter (PrimeExtensionCertificate (virtualPrimeUniverse (coreBallotShift k) (coreBallotScale k) k) (RankedImproperExtension (coreBallotShift k) (coreBallotScale k) k (coreProperCap k))), primeTiltWeight (virtualPrimeUniverse (coreBallotShift k) (coreBallotScale k) k) lam T) ≤ coreProperFailureError lam k := by have hk0 : 0 < k := by omega have hkR : (0 : ℝ) < k := by exact_mod_cast hk0 have hA : 0 < coreBallotShift k := by unfold coreBallotShift; positivity have hB := coreBallotScale_pos k have hP (p : ℕ) (hp : p ∈ virtualPrimeUniverse (coreBallotShift k) (coreBallotScale k) k) : p.Prime := by rw [virtualPrimeUniverse_eq_window hB] at hp exact (mem_primeLogWindow.mp hp).1 have hlog (p : ℕ) (hp : p ∈ virtualPrimeUniverse (coreBallotShift k) (coreBallotScale k) k) : log (p : ℝ) ≤ coreBallotShift k + coreBallotScale k * (2 : ℝ) ^ k := by rw [virtualPrimeUniverse_eq_window hB] at hp exact (mem_primeLogWindow.mp hp).2.2 have htheta : (∑ p ∈ virtualPrimeUniverse (coreBallotShift k) (coreBallotScale k) k, primeTiltSelectionProbability lam p) ≤ lam * k * log 2 + 2 * lam * primeLogOddsErrorConstant / (coreBallotShift k + coreBallotScale k) := by apply (sum_le_sum (fun p hp ↦ primeTiltSelectionProbability_le_intensity (hP p hp) (by linarith))).trans exact virtualPrime_total_intensity_upper hA.le hB (coreBallot_base_large k) hlam hlam2 k have hraw := ranked_improper_certificate_mass_le (k := k) hP hA hB (by positivity) hlam hlam2 (coreProperCap_pos k) (coreProperCap_scale_admissible hk) hlog apply hraw.trans unfold coreProperFailureError exact mul_le_mul_of_nonneg_right (exp_le_exp.mpr htheta) (by positivity [log_natCast_nonneg (2 * coreProperCap k)]) /-- The actual-law ranked-certificate error is below every prescribed fixed exponential rate, including the multiblock event's rate. -/ theorem virtualPrime_ranked_improper_mass_eventually_exponential {lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (c : ℝ) : ∀ᶠ k : ℕ in atTop, (∑ T ∈ (virtualPrimeUniverse (coreBallotShift k) (coreBallotScale k) k).powerset.filter (PrimeExtensionCertificate (virtualPrimeUniverse (coreBallotShift k) (coreBallotScale k) k) (RankedImproperExtension (coreBallotShift k) (coreBallotScale k) k (coreProperCap k))), primeTiltWeight (virtualPrimeUniverse (coreBallotShift k) (coreBallotScale k) k) lam T) ≤ exp (-c * (k : ℝ)) := by filter_upwards [eventually_ge_atTop 50, coreProperFailureError_eventually_exponential hlam hlam2 c] with k hk he exact (virtualPrime_ranked_improper_mass_le_error hk hlam hlam2).trans he end Erdos859Verification end /- Inlined development module: CoreProperBlockProbability.lean -/ section /- The actual multiblock event retains its rate after arithmetic certificates are removed. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification noncomputable def coreRatePrimeUniverse (s : ℕ) : Finset ℕ := virtualPrimeUniverse (coreBallotShift (coreRateTotalLength s)) (coreBallotScale (coreRateTotalLength s)) (coreRateTotalLength s) def CoreRateNoRankedFailure (eta : ℝ) (s : ℕ) (T : Finset ℕ) : Prop := CoreMultiBlockEvent (coreBallotShift (coreRateTotalLength s)) (coreBallotScale (coreRateTotalLength s)) eta (coreRatePrefixLength s) (coreRateSuffixLength s) (coreRateBlockCount s) T ∧ ¬ PrimeExtensionCertificate (coreRatePrimeUniverse s) (RankedImproperExtension (coreBallotShift (coreRateTotalLength s)) (coreBallotScale (coreRateTotalLength s)) (coreRateTotalLength s) (coreProperCap (coreRateTotalLength s))) T noncomputable def coreRateNoRankedFailureMass (eta lam : ℝ) (s : ℕ) : ℝ := by classical exact ∑ T ∈ (coreRatePrimeUniverse s).powerset.filter (CoreRateNoRankedFailure eta s), primeTiltWeight (coreRatePrimeUniverse s) lam T theorem finite_good_event_subtract {α : Type*} (S : Finset α) (w : α → ℝ) (Good Bad : α → Prop) [DecidablePred Good] [DecidablePred Bad] (hw : ∀ x ∈ S, 0 ≤ w x) : (∑ x ∈ S.filter Good, w x) - (∑ x ∈ S.filter Bad, w x) ≤ ∑ x ∈ S.filter (fun x ↦ Good x ∧ ¬ Bad x), w x := by classical rw [sum_filter, sum_filter, sum_filter, ← sum_sub_distrib] apply sum_le_sum intro x hx by_cases hg : Good x <;> by_cases hb : Bad x <;> simp [hg, hb, hw x hx] theorem coreRateNoRankedFailure_probability_lower {eta lam eps : ℝ} (heta : 0 < eta) (heta2 : eta ≤ log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) (heps : 0 < eps) : ∀ᶠ s : ℕ in atTop, exp (-(corePrefixRate lam + eps) * (coreRateTotalLength s : ℝ)) ≤ coreRateNoRankedFailureMass eta lam s := by classical have heps2 : 0 < eps / 2 := by linarith have hprob := coreRate_actual_probability_lower heta heta2 hlam hlam2 heps2 have herror := coreRateTotalLength_tendsto.eventually (virtualPrime_ranked_improper_mass_eventually_exponential hlam hlam2 (corePrefixRate lam + eps / 2 + 1)) filter_upwards [hprob, herror, coreRateLength_eventually_split, coreRateTotalLength_real_tendsto.eventually_ge_atTop (log 2), coreRateTotalLength_real_tendsto.eventually_ge_atTop (log 2 / (eps / 2))] with s hgood hbad hsplit hklog hkscale let k := coreRateTotalLength s let P := coreRatePrimeUniverse s let Good := CoreMultiBlockEvent (coreBallotShift k) (coreBallotScale k) eta (coreRatePrefixLength s) (coreRateSuffixLength s) (coreRateBlockCount s) let Bad := PrimeExtensionCertificate P (RankedImproperExtension (coreBallotShift k) (coreBallotScale k) k (coreProperCap k)) have hP (p : ℕ) (hp : p ∈ P) : p.Prime := by change p ∈ virtualPrimeUniverse (coreBallotShift k) (coreBallotScale k) k at hp rw [virtualPrimeUniverse_eq_window (coreBallotScale_pos k)] at hp exact (mem_primeLogWindow.mp hp).1 have hlen : coreRateBlockCount s * (coreRatePrefixLength s + coreRateSuffixLength s) = k := by rw [hsplit.2] exact Nat.mul_comm _ _ have hgood' : exp (-(corePrefixRate lam + eps / 2) * (k : ℝ)) ≤ ∑ T ∈ P.powerset.filter Good, primeTiltWeight P lam T := by simpa only [coreMultiBlockEventMass, hlen] using! hgood have hbad' : (∑ T ∈ P.powerset.filter Bad, primeTiltWeight P lam T) ≤ exp (-(corePrefixRate lam + eps / 2 + 1) * (k : ℝ)) := hbad have hsmall : exp (-(k : ℝ)) ≤ (1 / 2 : ℝ) := by calc _ ≤ exp (-log 2) := exp_le_exp.mpr (by simpa only [k] using neg_le_neg hklog) _ = _ := by rw [exp_neg, exp_log (by norm_num)]; norm_num have hsmall' : exp (-(eps / 2) * (k : ℝ)) ≤ (1 / 2 : ℝ) := by have hkscale' := (div_le_iff₀ heps2).mp hkscale calc _ ≤ exp (-log 2) := exp_le_exp.mpr (by dsimp [k]; nlinarith) _ = _ := by rw [exp_neg, exp_log (by norm_num)]; norm_num have hbadhalf : exp (-(corePrefixRate lam + eps / 2 + 1) * (k : ℝ)) ≤ (1 / 2 : ℝ) * exp (-(corePrefixRate lam + eps / 2) * (k : ℝ)) := by calc _ = exp (-(k : ℝ)) * exp (-(corePrefixRate lam + eps / 2) * (k : ℝ)) := by rw [← exp_add]; congr 1; ring _ ≤ _ := mul_le_mul_of_nonneg_right hsmall (exp_pos _).le have htargethalf : exp (-(corePrefixRate lam + eps) * (k : ℝ)) ≤ (1 / 2 : ℝ) * exp (-(corePrefixRate lam + eps / 2) * (k : ℝ)) := by calc _ = exp (-(eps / 2) * (k : ℝ)) * exp (-(corePrefixRate lam + eps / 2) * (k : ℝ)) := by rw [← exp_add]; congr 1; ring _ ≤ _ := mul_le_mul_of_nonneg_right hsmall' (exp_pos _).le have hsurvive := finite_good_event_subtract P.powerset (primeTiltWeight P lam) Good Bad (fun T _ ↦ (primeTiltWeight_pos hP (by linarith) T).le) have hfinal : exp (-(corePrefixRate lam + eps) * (k : ℝ)) ≤ ∑ T ∈ P.powerset.filter (fun T ↦ Good T ∧ ¬ Bad T), primeTiltWeight P lam T := by linarith apply hfinal.trans apply le_of_eq unfold coreRateNoRankedFailureMass simp only [sum_filter] apply sum_congr rfl intro T _ by_cases h : CoreRateNoRankedFailure eta s T · have h' : Good T ∧ ¬ Bad T := h rw [if_pos h', if_pos h] · have h' : ¬ (Good T ∧ ¬ Bad T) := h rw [if_neg h', if_neg h] end Erdos859Verification end /- Inlined development module: CoreBlockRank.lean -/ section /- Actual block ballots imply the lower location bound at every selected-prime rank. -/ namespace Erdos859Verification open Finset Real theorem virtualPrimeUniverse_mono (A B : ℝ) {m n : ℕ} (hmn : m ≤ n) : virtualPrimeUniverse A B m ⊆ virtualPrimeUniverse A B n := by intro p hp obtain ⟨j, hj, hpb⟩ := mem_biUnion.mp hp exact mem_biUnion.mpr ⟨j, mem_range.mpr ((mem_range.mp hj).trans_le hmn), hpb⟩ theorem virtualPrimeUniverse_succ (A B : ℝ) (n : ℕ) : virtualPrimeUniverse A B (n + 1) = virtualPrimeUniverse A B n ∪ virtualPrimeBand A B n := by simp only [virtualPrimeUniverse, range_add_one, biUnion_insert, union_comm] theorem virtualPrimeBinIndex_lt_iff {A B : ℝ} (hB : 0 < B) {n j : ℕ} (hj : j ≤ n) (p : virtualPrimeUniverse A B n) : (virtualPrimeBinIndex A B n p).val < j ↔ p.val ∈ virtualPrimeUniverse A B j := by constructor · intro hp exact virtualPrimeBand_subset_universe A B hp (virtualPrimeBinIndex_mem A B n p) · intro hp obtain ⟨i, hi, hpi⟩ := mem_biUnion.mp hp let q : Fin n := ⟨i, (mem_range.mp hi).trans_le hj⟩ have hq := (virtualPrimeBinIndex_eq_iff hB n p q).mpr hpi rw [hq] exact mem_range.mp hi theorem primeSubsetBallot_virtual_prefix_card {A B : ℝ} (hB : 0 < B) {n j : ℕ} (hj : j ≤ n) {T : Finset ℕ} (hballot : primeSubsetBallot (virtualPrimeUniverse A B n) (virtualPrimeBinIndex A B n) T) : (T ∩ virtualPrimeUniverse A B j).card ≤ j := by classical let P := virtualPrimeUniverse A B n let bin := virtualPrimeBinIndex A B n have hsum : (∑ i : Fin n with i.val < j, primeSubsetBinCount P bin T i) = (univ.filter fun p : P ↦ p.val ∈ T ∧ (bin p).val < j).card := by simpa only [primeSubsetBinCount, filter_filter, mem_filter, mem_univ, true_and] using sum_card_fiberwise_eq_card_filter (univ.filter fun p : P ↦ p.val ∈ T) (univ.filter fun i : Fin n ↦ i.val < j) bin have hcard : (univ.filter fun p : P ↦ p.val ∈ T ∧ (bin p).val < j).card = (T ∩ virtualPrimeUniverse A B j).card := by apply card_bij (fun p _ ↦ p.val) · intro p hp exact mem_inter.mpr ⟨(mem_filter.mp hp).2.1, (virtualPrimeBinIndex_lt_iff hB hj p).mp (mem_filter.mp hp).2.2⟩ · intro p _ q _ hpq exact Subtype.ext hpq · intro p hp let q : P := ⟨p, virtualPrimeUniverse_mono A B hj (mem_inter.mp hp).2⟩ refine ⟨q, mem_filter.mpr ⟨mem_univ _, (mem_inter.mp hp).1, ?_⟩, rfl⟩ exact (virtualPrimeBinIndex_lt_iff hB hj q).mpr (mem_inter.mp hp).2 have hb := hballot j hj change (∑ i : Fin n with i.val < j, primeSubsetBinCount P bin T i) ≤ j at hb rwa [hsum, hcard] at hb theorem coreBlockEvent_prefix_card {A B eta : ℝ} (hB : 0 < B) {n K : ℕ} {T : Finset ℕ} (hevent : CoreBlockEvent A B eta n K T) : ∀ j ≤ n + K, (T ∩ virtualPrimeUniverse A B j).card ≤ j := by intro j induction j with | zero => intro _; simp [virtualPrimeUniverse] | succ j ih => intro hj by_cases hjn : j + 1 ≤ n · have h := primeSubsetBallot_virtual_prefix_card hB hjn hevent.2.1 have heq : (T ∩ virtualPrimeUniverse A B n) ∩ virtualPrimeUniverse A B (j + 1) = T ∩ virtualPrimeUniverse A B (j + 1) := by rw [inter_assoc, inter_eq_right.mpr (virtualPrimeUniverse_mono A B hjn)] rwa [heq] at h · have hnj : n ≤ j := by omega have hjK : j - n < K := by omega have hs := (hevent.2.2 ⟨j - n, hjK⟩).1 simp only [Nat.add_sub_of_le hnj] at hs rw [virtualPrimeUniverse_succ, inter_union_distrib_left] have hle := card_union_le (T ∩ virtualPrimeUniverse A B j) (T ∩ virtualPrimeBand A B j) have hprev := ih (by omega) rw [hs] at hle omega theorem virtualPrimeUniverse_add {A B : ℝ} (hB : 0 < B) (s i : ℕ) : virtualPrimeUniverse A B (s + i) = virtualPrimeUniverse A B s ∪ virtualPrimeUniverse A (B * 2 ^ s) i := by rw [virtualPrimeUniverse_eq_window hB, virtualPrimeUniverse_eq_window hB, virtualPrimeUniverse_eq_window (by positivity : 0 < B * (2 : ℝ) ^ s)] simp only [pow_add, mul_assoc] apply (primeLogWindow_union_adjacent ?_ ?_).symm · have hs : (1 : ℝ) ≤ 2 ^ s := one_le_pow₀ (by norm_num) nlinarith · have hi : (1 : ℝ) ≤ 2 ^ i := one_le_pow₀ (by norm_num) have hm := mul_le_mul_of_nonneg_left hi (show (0 : ℝ) ≤ B * 2 ^ s by positivity) nlinarith only [hm] theorem coreMultiBlockEvent_prefix_card {A B eta : ℝ} (hB : 0 < B) {n K r : ℕ} {T : Finset ℕ} : CoreMultiBlockEvent A B eta n K r T → ∀ j ≤ r * (n + K), (T ∩ virtualPrimeUniverse A B j).card ≤ j := by induction r with | zero => intro _ j hj have hj0 : j = 0 := by omega subst j simp [virtualPrimeUniverse] | succ r ih => intro hevent j hj have hold : CoreMultiBlockEvent A B eta n K r T := fun b ↦ hevent ⟨b.val, b.isLt.trans (Nat.lt_succ_self r)⟩ by_cases hsmall : j ≤ r * (n + K) · exact ih hold j hsmall · have hrj : r * (n + K) ≤ j := by omega have hremain : j - r * (n + K) ≤ n + K := by rw [Nat.succ_mul] at hj omega have hlocal := coreBlockEvent_prefix_card (by positivity : 0 < B * (2 : ℝ) ^ (r * (n + K))) (hevent ⟨r, Nat.lt_succ_self r⟩) (j - r * (n + K)) hremain have heq : (T ∩ coreMultiBlockBand A B (n + K) r) ∩ virtualPrimeUniverse A (B * 2 ^ (r * (n + K))) (j - r * (n + K)) = T ∩ virtualPrimeUniverse A (B * 2 ^ (r * (n + K))) (j - r * (n + K)) := by rw [coreMultiBlockBand, inter_assoc, inter_eq_right.mpr (virtualPrimeUniverse_mono A _ hremain)] rw [heq] at hlocal have hprev := ih hold (r * (n + K)) le_rfl have hsplit : virtualPrimeUniverse A B j = virtualPrimeUniverse A B (r * (n + K)) ∪ virtualPrimeUniverse A (B * 2 ^ (r * (n + K))) (j - r * (n + K)) := by nth_rw 1 [← Nat.add_sub_of_le hrj] exact virtualPrimeUniverse_add hB _ _ rw [hsplit, inter_union_distrib_left] have hc := card_union_le (T ∩ virtualPrimeUniverse A B (r * (n + K))) (T ∩ virtualPrimeUniverse A (B * 2 ^ (r * (n + K))) (j - r * (n + K))) omega /-- Every selected prime lies beyond the virtual boundary indexed by its previous-prime count. -/ theorem coreMultiBlockEvent_rank_lower {A B eta : ℝ} (hB : 0 < B) {n K r : ℕ} {T : Finset ℕ} (hT : T ⊆ virtualPrimeUniverse A B (r * (n + K))) (hevent : CoreMultiBlockEvent A B eta n K r T) : ∀ p ∈ T, A + B * (2 : ℝ) ^ (T.filter (fun q ↦ q < p)).card ≤ log (p : ℝ) := by intro p hp obtain ⟨j, hj, hpj⟩ := mem_biUnion.mp (hT hp) have hjlt : j < r * (n + K) := mem_range.mp hj obtain ⟨_, hplow, hphigh⟩ := mem_primeLogWindow.mp hpj have hsub : insert p (T.filter (fun q ↦ q < p)) ⊆ T ∩ virtualPrimeUniverse A B (j + 1) := by intro q hq rcases mem_insert.mp hq with rfl | hq · exact mem_inter.mpr ⟨hp, virtualPrimeBand_subset_universe A B (Nat.lt_succ_self j) hpj⟩ · obtain ⟨hqT, hqp⟩ := mem_filter.mp hq have hqw := hT hqT rw [virtualPrimeUniverse_eq_window hB] at hqw obtain ⟨hqprime, hqlow, _⟩ := mem_primeLogWindow.mp hqw have hlog : log (q : ℝ) ≤ log (p : ℝ) := log_le_log (by exact_mod_cast hqprime.pos) (by exact_mod_cast hqp.le) apply mem_inter.mpr ⟨hqT, ?_⟩ rw [virtualPrimeUniverse_eq_window hB] exact mem_primeLogWindow.mpr ⟨hqprime, hqlow, hlog.trans hphigh⟩ have hcount := (card_le_card hsub).trans (coreMultiBlockEvent_prefix_card hB hevent (j + 1) (Nat.succ_le_of_lt hjlt)) have hpnot : p ∉ T.filter (fun q ↦ q < p) := by simp rw [card_insert_of_notMem hpnot] at hcount have hrank : (T.filter (fun q ↦ q < p)).card ≤ j := by omega calc _ ≤ A + B * (2 : ℝ) ^ j := add_le_add le_rfl (mul_le_mul_of_nonneg_left (pow_le_pow_right₀ (by norm_num) hrank) hB.le) _ ≤ _ := hplow.le end Erdos859Verification end /- Inlined development module: CoreRankedFirstFailure.lean -/ section /- An improper selected divisor cube gives an actual ranked extension certificate. -/ open Finset Real namespace Erdos859Verification theorem improper_subset_has_ranked_certificate {P T : Finset ℕ} {A B : ℝ} {k H : ℕ} (hTP : T ⊆ P) (hcard : T.card ≤ k) (hB : 0 ≤ B) (hrank : ∀ p ∈ T, A + B * (2 : ℝ) ^ (T.filter (fun q ↦ q < p)).card ≤ log (p : ℝ)) (hbad : ¬ IsProperSignedCube (divisorCubeWeight T) H) : PrimeExtensionCertificate P (RankedImproperExtension A B k H) T := by classical obtain ⟨S, hS, hmin⟩ := (T.powerset.filter (fun S ↦ ¬ IsProperSignedCube (divisorCubeWeight S) H)).exists_min_image Finset.card ⟨T, mem_filter.mpr ⟨mem_powerset_self T, hbad⟩⟩ have hST : S ⊆ T := mem_powerset.mp (mem_filter.mp hS).1 have hbadS := (mem_filter.mp hS).2 have hSne : S.Nonempty := by apply nonempty_iff_ne_empty.mpr intro he exact hbadS (he ▸ isProper_divisorCube_empty H) let p := S.max' hSne have hpS : p ∈ S := max'_mem S hSne have hpT : p ∈ T := hST hpS have hproper : IsProperSignedCube (divisorCubeWeight (S.erase p)) H := by by_contra hn have h := hmin (S.erase p) (mem_filter.mpr ⟨mem_powerset.mpr ((erase_subset _ _).trans hST), hn⟩) have hc := card_erase_of_mem hpS have hpos := card_pos.mpr hSne omega have hsub : S.erase p ⊆ T.filter (fun q ↦ q < p) := by intro q hq obtain ⟨hqp, hqS⟩ := mem_erase.mp hq have hle : q ≤ p := le_max' S q hqS exact mem_filter.mpr ⟨hST hqS, lt_of_le_of_ne hle hqp⟩ have hbound : A + B * (2 : ℝ) ^ (S.erase p).card ≤ log (p : ℝ) := by apply le_trans _ (hrank p hpT) exact add_le_add le_rfl (mul_le_mul_of_nonneg_left (pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 2) (card_le_card hsub)) hB) refine ⟨S.erase p, mem_powerset.mpr ((erase_subset _ _).trans (hST.trans hTP)), p, hTP hpT, notMem_erase _ _, ?_, ?_⟩ · refine ⟨(card_le_card ((erase_subset _ _).trans hST)).trans hcard, hproper, ?_, hbound⟩ rwa [Finset.insert_erase hpS] · simpa only [insert_erase hpS] using hST end Erdos859Verification end /- Inlined development module: FordRadicalUniverse.lean -/ section /- Arbitrary finite prime universes are dominated by the canonical radical event. -/ open Finset Real open scoped Classical namespace Erdos859Verification theorem fordRadicalDivisorEvent_mono {S T : Finset ℕ} (hST : S ⊆ T) {x : ℝ} (h : FordRadicalDivisorEvent x S) : FordRadicalDivisorEvent x T := by obtain ⟨U, hU, hlo, hhi⟩ := h exact ⟨U, hU.trans hST, hlo, hhi⟩ theorem fordRadicalDivisorEvent_cutoff {P T : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hTP : T ⊆ P) {x : ℝ} (hx : 0 ≤ x) : FordRadicalDivisorEvent x T ↔ FordRadicalDivisorEvent x (T ∩ fordPrimesUpTo ⌊2 * x⌋₊) := by constructor · rintro ⟨U, hUT, hlo, hhi⟩ refine ⟨U, ?_, hlo, hhi⟩ intro p hp have hpT := hUT hp have hpprime := hP p (hTP hpT) have hleNat : p ≤ ∏ q ∈ U, q := single_le_prod' (fun q hq ↦ (hP q (hTP (hUT hq))).one_le) hp have hle' : (p : ℝ) ≤ ((∏ q ∈ U, q : ℕ) : ℝ) := Nat.cast_le.mpr hleNat have hle : (p : ℝ) ≤ ∏ q ∈ U, (q : ℝ) := by simpa only [Nat.cast_prod] using hle' have hfloor : p ≤ ⌊2 * x⌋₊ := (Nat.le_floor_iff (mul_nonneg (by norm_num) hx)).mpr (hle.trans hhi) exact mem_inter.mpr ⟨hpT, mem_filter.mpr ⟨mem_range.mpr (by omega), hpprime⟩⟩ · exact fordRadicalDivisorEvent_mono inter_subset_left theorem primePattern_event_restrict {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) (E : Finset ℕ → Prop) : (∑ T ∈ P.powerset.filter (fun T ↦ E (T ∩ B)), primePatternWeight P T) = ∑ U ∈ B.powerset.filter E, primePatternWeight B U := by simpa only [primeTiltWeight, primeTiltNormalizer, sub_self, zero_div, add_zero, prod_const_one, one_pow, mul_one, div_one] using prime_tilt_event_restrict hP hB (lam := 1) (by norm_num) E theorem primePattern_radical_mass_mono {P B : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hB : B ⊆ P) (x : ℝ) : (∑ U ∈ B.powerset.filter (FordRadicalDivisorEvent x), primePatternWeight B U) ≤ ∑ T ∈ P.powerset.filter (FordRadicalDivisorEvent x), primePatternWeight P T := by rw [← primePattern_event_restrict hP hB (FordRadicalDivisorEvent x)] apply sum_le_sum_of_subset_of_nonneg · intro T hT exact mem_filter.mpr ⟨(mem_filter.mp hT).1, fordRadicalDivisorEvent_mono inter_subset_left (mem_filter.mp hT).2⟩ · intro T _ _ exact (primePatternWeight_pos hP T).le theorem radical_mass_le_canonical {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {x : ℝ} (hx : 0 ≤ x) : (∑ T ∈ P.powerset.filter (FordRadicalDivisorEvent x), primePatternWeight P T) ≤ fordRadicalMass x := by let C := fordPrimesUpTo ⌊2 * x⌋₊ have hfilter : P.powerset.filter (FordRadicalDivisorEvent x) = P.powerset.filter (fun T ↦ FordRadicalDivisorEvent x (T ∩ (P ∩ C))) := by ext T simp only [mem_filter] constructor · rintro ⟨hT, he⟩ have hTP := mem_powerset.mp hT have hi : T ∩ (P ∩ C) = T ∩ C := by rw [← inter_assoc, inter_eq_left.mpr hTP] exact ⟨hT, hi ▸ (fordRadicalDivisorEvent_cutoff hP hTP hx).mp he⟩ · rintro ⟨hT, he⟩ exact ⟨hT, fordRadicalDivisorEvent_mono inter_subset_left he⟩ rw [hfilter, primePattern_event_restrict hP inter_subset_left] exact primePattern_radical_mass_mono (fordPrimesUpTo_prime _) inter_subset_right x end Erdos859Verification end /- Inlined development module: FordRadicalShiftBound.lean -/ section /- Uniform radical bounds under divisor shifts and a powerful-factor convolution. -/ open Finset Real Filter open scoped Topology Classical namespace Erdos859Verification noncomputable def fordRadicalShiftNumeratorConstant : ℝ := fordRadicalNumeratorConstant * (2 : ℝ) ^ fordUpperExponent * (2 : ℝ) ^ (5 / 4 : ℝ) noncomputable def fordRadicalShiftEnvelope (y : ℝ) : ℝ := (4 * fordRadicalSupportConstant / (log y) ^ 2) * (2 * log 2 + fordRadicalShiftNumeratorConstant * (log y) ^ fordUpperExponent / (log (log y)) ^ (5 / 4 : ℝ)) theorem fordRadicalShiftNumeratorConstant_pos : 0 < fordRadicalShiftNumeratorConstant := by unfold fordRadicalShiftNumeratorConstant have := fordRadicalNumeratorConstant_pos positivity theorem fordRadicalShiftEnvelope_nonneg {y : ℝ} (hy : 4 ≤ y) (hlarge : 2 * log 2 ≤ log (log y)) : 0 ≤ fordRadicalShiftEnvelope y := by have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hylog : 0 < log y := log_pos (by linarith) have hyll : 0 < log (log y) := by linarith have := fordRadicalShiftNumeratorConstant_pos have := fordRadicalSupportConstant_pos unfold fordRadicalShiftEnvelope positivity theorem ford_shift_log_bounds {y z : ℝ} (hy : 4 ≤ y) (hlarge : 2 * log 2 ≤ log (log y)) (hzlo : sqrt y ≤ z) (hzhi : z ≤ y) : log y / 2 ≤ log (2 * z) ∧ log (2 * z) ≤ 2 * log y ∧ log (log y) / 2 ≤ log (log (2 * z)) := by have hy0 : 0 < y := by linarith have hz0 : 0 < z := (sqrt_pos.mpr hy0).trans_le hzlo have hlogy : 0 < log y := log_pos (by linarith) have hlog2 : 0 < log (2 : ℝ) := log_pos (by norm_num) have hlo : log y / 2 ≤ log (2 * z) := by rw [← log_sqrt hy0.le] exact log_le_log (sqrt_pos.mpr hy0) (by linarith) have hhi : log (2 * z) ≤ 2 * log y := by have h := log_le_log (by positivity : 0 < 2 * z) (show 2 * z ≤ 2 * y by linarith) rw [log_mul (by norm_num : (2 : ℝ) ≠ 0) hy0.ne'] at h have h2y := log_le_log (by norm_num : (0 : ℝ) < 2) (show 2 ≤ y by linarith) linarith have hll := log_le_log (by positivity : 0 < log y / 2) hlo rw [log_div hlogy.ne' (by norm_num : (2 : ℝ) ≠ 0)] at hll exact ⟨hlo, hhi, by linarith⟩ theorem fordRadicalMass_eventual_uniform_shift : ∀ᶠ y : ℝ in atTop, ∀ z : ℝ, sqrt y ≤ z → z ≤ y → fordRadicalMass z ≤ fordRadicalShiftEnvelope y := by obtain ⟨z0, hz0⟩ := eventually_atTop.mp fordRadicalMass_eventual_upper filter_upwards [tendsto_sqrt_atTop.eventually_ge_atTop z0, eventually_ge_atTop 4, (tendsto_log_atTop.comp tendsto_log_atTop).eventually_ge_atTop (2 * log 2)] with y hyz hy hlarge change 2 * log 2 ≤ log (log y) at hlarge intro z hzlo hzhi have hraw := hz0 z (hyz.trans hzlo) obtain ⟨hlo, hhi, hll⟩ := ford_shift_log_bounds hy hlarge hzlo hzhi have hlog2 : 0 < log (2 : ℝ) := log_pos (by norm_num) have hylog : 0 < log y := log_pos (by linarith) have hyll : 0 < log (log y) := by linarith have hzlog : 0 < log (2 * z) := by linarith have hzll : 0 < log (log (2 * z)) := by linarith have hcoef : fordRadicalSupportConstant / (log (2 * z)) ^ 2 ≤ 4 * fordRadicalSupportConstant / (log y) ^ 2 := by calc _ ≤ fordRadicalSupportConstant / (log y / 2) ^ 2 := div_le_div₀ fordRadicalSupportConstant_pos.le le_rfl (by positivity) (pow_le_pow_left₀ (by positivity) hlo 2) _ = _ := by ring have hfrac : (log (2 * z)) ^ fordUpperExponent / (log (log (2 * z))) ^ (5 / 4 : ℝ) ≤ (2 : ℝ) ^ fordUpperExponent * (2 : ℝ) ^ (5 / 4 : ℝ) * (log y) ^ fordUpperExponent / (log (log y)) ^ (5 / 4 : ℝ) := by calc _ ≤ (2 * log y) ^ fordUpperExponent / (log (log y) / 2) ^ (5 / 4 : ℝ) := div_le_div₀ (by positivity) (rpow_le_rpow hzlog.le hhi fordUpperExponent_pos.le) (by positivity) (rpow_le_rpow (by positivity) hll (by norm_num)) _ = _ := by rw [mul_rpow (by norm_num) hylog.le, div_rpow hyll.le (by norm_num), div_div_eq_mul_div] ring have hnum : 2 * log 2 + fordRadicalNumeratorConstant * (log (2 * z)) ^ fordUpperExponent / (log (log (2 * z))) ^ (5 / 4 : ℝ) ≤ 2 * log 2 + fordRadicalShiftNumeratorConstant * (log y) ^ fordUpperExponent / (log (log y)) ^ (5 / 4 : ℝ) := by have h := mul_le_mul_of_nonneg_left hfrac fordRadicalNumeratorConstant_pos.le unfold fordRadicalShiftNumeratorConstant simpa only [mul_div_assoc, mul_assoc] using add_le_add (le_refl (2 * log 2)) h apply hraw.trans unfold fordRadicalShiftEnvelope exact mul_le_mul hcoef hnum (by positivity [fordRadicalNumeratorConstant_pos]) (by positivity [fordRadicalSupportConstant_pos]) theorem fordRadicalShiftEnvelope_scaled_tendsto_zero : Tendsto (fun y : ℝ ↦ (log y) ^ fordDecayExponent * fordRadicalShiftEnvelope y) atTop (𝓝 0) := by have hlog := tendsto_log_atTop have hll := tendsto_log_atTop.comp tendsto_log_atTop have hfirst := ((tendsto_rpow_neg_atTop fordUpperExponent_pos).comp hlog).const_mul (2 * log 2) have hsecond := (((tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 5 / 4)).comp hll).inv_tendsto_atTop).const_mul fordRadicalShiftNumeratorConstant have hupper : Tendsto (fun y : ℝ ↦ (4 * fordRadicalSupportConstant) * (2 * log 2 * (log y) ^ (-fordUpperExponent) + fordRadicalShiftNumeratorConstant / (log (log y)) ^ (5 / 4 : ℝ))) atTop (𝓝 0) := by simpa only [mul_zero, add_zero, div_eq_mul_inv, Function.comp_apply, Pi.inv_apply] using (hfirst.add hsecond).const_mul (4 * fordRadicalSupportConstant) apply hupper.congr' filter_upwards [eventually_gt_atTop (1 : ℝ)] with y hy unfold fordRadicalShiftEnvelope rw [← mul_assoc, ford_critical_scaling_identity (log_pos hy)] theorem ford_critical_scaling_log_identity {x L : ℝ} (hx : 0 < x) (hL : 0 < L) (K a C : ℝ) : x ^ fordDecayExponent * L * (K / x ^ 2) * (a + C * x ^ fordUpperExponent / L ^ (5 / 4 : ℝ)) = K * (a * (L / x ^ fordUpperExponent) + C * L ^ (-1 / 4 : ℝ)) := by have hLp : L / L ^ (5 / 4 : ℝ) = L ^ (-1 / 4 : ℝ) := by nth_rw 1 [← rpow_one L] rw [← rpow_sub hL] norm_num calc _ = L * (x ^ fordDecayExponent * (K / x ^ 2) * (a + C * x ^ fordUpperExponent / L ^ (5 / 4 : ℝ))) := by ring _ = L * (K * (a * x ^ (-fordUpperExponent) + C / L ^ (5 / 4 : ℝ))) := by rw [ford_critical_scaling_identity hx] _ = K * (a * (L / x ^ fordUpperExponent) + C * (L / L ^ (5 / 4 : ℝ))) := by rw [rpow_neg hx.le] ring _ = _ := by rw [hLp] /-- The extra logarithm pays for the later dyadic union. -/ theorem fordRadicalShiftEnvelope_log_scaled_tendsto_zero : Tendsto (fun y : ℝ ↦ (log y) ^ fordDecayExponent * log (log y) * fordRadicalShiftEnvelope y) atTop (𝓝 0) := by have hfirst := ((isLittleO_log_rpow_atTop fordUpperExponent_pos).tendsto_div_nhds_zero.comp tendsto_log_atTop).const_mul (2 * log 2) have hsecond := ((tendsto_rpow_neg_atTop (by norm_num : (0 : ℝ) < 1 / 4)).comp (tendsto_log_atTop.comp tendsto_log_atTop)).const_mul fordRadicalShiftNumeratorConstant have hu : Tendsto (fun y : ℝ ↦ (4 * fordRadicalSupportConstant) * (2 * log 2 * (log (log y) / (log y) ^ fordUpperExponent) + fordRadicalShiftNumeratorConstant * (log (log y)) ^ (-1 / 4 : ℝ))) atTop (𝓝 0) := by simpa only [Function.comp_apply, mul_zero, add_zero, neg_div] using (hfirst.add hsecond).const_mul (4 * fordRadicalSupportConstant) apply hu.congr' filter_upwards [tendsto_log_atTop.eventually_gt_atTop 1] with y hy unfold fordRadicalShiftEnvelope rw [← mul_assoc, ford_critical_scaling_log_identity (by linarith) (log_pos hy)] end Erdos859Verification end /- Inlined development module: FordPowerfulConvolution.lean -/ section /- A finite powerful-factor convolution of the actual radical-divisor masses. -/ open Finset Real Filter open scoped Topology Classical namespace Erdos859Verification theorem ford_divisor_shift_in_range {y : ℝ} (hy : 0 < y) {B f : ℕ} (hB : (B : ℝ) ≤ sqrt y) (hf : f ∈ B.divisors) : sqrt y ≤ y / f ∧ y / f ≤ y := by obtain ⟨hfd, hB0⟩ := Nat.mem_divisors.mp hf have hf0 : f ≠ 0 := by intro hz subst f exact hB0 (zero_dvd_iff.mp hfd) have hfR : (0 : ℝ) < f := Nat.cast_pos.mpr (Nat.pos_of_ne_zero hf0) have hf1 : (1 : ℝ) ≤ f := by exact_mod_cast Nat.pos_of_ne_zero hf0 have hfB : (f : ℝ) ≤ sqrt y := (Nat.cast_le.mpr (Nat.le_of_dvd (Nat.pos_of_ne_zero hB0) hfd)).trans hB constructor · apply (le_div_iff₀ hfR).mpr have hm := mul_le_mul_of_nonneg_left hfB (sqrt_nonneg y) nlinarith only [hm, sq_sqrt hy.le] · apply (div_le_iff₀ hfR).mpr nlinarith theorem fordRadicalMass_eventual_divisor_sum : ∀ᶠ y : ℝ in atTop, ∀ B : ℕ, (B : ℝ) ≤ sqrt y → (∑ f ∈ B.divisors, fordRadicalMass (y / f)) ≤ (B.divisors.card : ℝ) * fordRadicalShiftEnvelope y := by filter_upwards [fordRadicalMass_eventual_uniform_shift, eventually_gt_atTop 0] with y hshift hy intro B hB calc _ ≤ ∑ _f ∈ B.divisors, fordRadicalShiftEnvelope y := by apply sum_le_sum intro f hf have hrange := ford_divisor_shift_in_range hy hB hf exact hshift (y / f) hrange.1 hrange.2 _ = _ := by rw [sum_const, nsmul_eq_mul] noncomputable def fordPowerfulConvolution (T : Finset ℕ) (y : ℝ) : ℝ := ∑ B ∈ T, if (B : ℝ) ≤ sqrt y then (∑ f ∈ B.divisors, fordRadicalMass (y / f)) / B else 1 / (B : ℝ) noncomputable def fordPowerfulConvolutionEnvelope (y : ℝ) : ℝ := ((768 : ℝ) ^ 4 * fordPowerfulTailConstant) * fordRadicalShiftEnvelope y + fordPowerfulTailConstant / y ^ (1 / 8 : ℝ) theorem fordPowerfulConvolution_nonneg (T : Finset ℕ) (y : ℝ) : 0 ≤ fordPowerfulConvolution T y := by apply sum_nonneg intro B _ split_ifs · exact div_nonneg (sum_nonneg fun _ _ ↦ fordRadicalMass_nonneg _) (Nat.cast_nonneg B) · positivity theorem fordPowerfulConvolution_eventual_upper : ∀ᶠ y : ℝ in atTop, ∀ T : Finset ℕ, (∀ B ∈ T, FordPowerful B) → fordPowerfulConvolution T y ≤ fordPowerfulConvolutionEnvelope y := by filter_upwards [fordRadicalMass_eventual_divisor_sum, eventually_ge_atTop 4, (tendsto_log_atTop.comp tendsto_log_atTop).eventually_ge_atTop (2 * log 2)] with y hrad hy hlarge intro T hT change 2 * log 2 ≤ log (log y) at hlarge have hy0 : 0 < y := by linarith have hE := fordRadicalShiftEnvelope_nonneg hy hlarge have hsmall : (∑ B ∈ T.filter (fun B : ℕ ↦ (B : ℝ) ≤ sqrt y), (∑ f ∈ B.divisors, fordRadicalMass (y / f)) / B) ≤ ((768 : ℝ) ^ 4 * fordPowerfulTailConstant) * fordRadicalShiftEnvelope y := by calc _ ≤ ∑ B ∈ T.filter (fun B : ℕ ↦ (B : ℝ) ≤ sqrt y), ((B.divisors.card : ℝ) * fordRadicalShiftEnvelope y) / B := sum_le_sum fun B hB ↦ div_le_div_of_nonneg_right (hrad B (mem_filter.mp hB).2) (Nat.cast_nonneg B) _ = fordRadicalShiftEnvelope y * ∑ B ∈ T.filter (fun B : ℕ ↦ (B : ℝ) ≤ sqrt y), (B.divisors.card : ℝ) / B := by rw [mul_sum] apply sum_congr rfl intro B _ ring _ ≤ fordRadicalShiftEnvelope y * ((768 : ℝ) ^ 4 * fordPowerfulTailConstant) := mul_le_mul_of_nonneg_left (ford_powerful_divisor_weight_sum_le _ (fun B hB ↦ hT B (mem_filter.mp hB).1)) hE _ = _ := mul_comm _ _ have htail := ford_powerful_reciprocal_tail_sum_le T (sqrt_pos.mpr hy0) hT have hsqrt : (sqrt y) ^ (1 / 4 : ℝ) = y ^ (1 / 8 : ℝ) := by rw [sqrt_eq_rpow, ← rpow_mul hy0.le] norm_num rw [hsqrt] at htail unfold fordPowerfulConvolution fordPowerfulConvolutionEnvelope rw [sum_ite] simp only [not_le] exact add_le_add hsmall htail theorem ford_powerful_tail_scaled_tendsto_zero : Tendsto (fun y : ℝ ↦ (log y) ^ fordDecayExponent / y ^ (1 / 8 : ℝ)) atTop (𝓝 0) := (isLittleO_log_rpow_rpow_atTop fordDecayExponent (by norm_num : (0 : ℝ) < 1 / 8)).tendsto_div_nhds_zero theorem ford_powerful_tail_log_scaled_tendsto_zero : Tendsto (fun y : ℝ ↦ (log y) ^ fordDecayExponent * log (log y) / y ^ (1 / 8 : ℝ)) atTop (𝓝 0) := by have hu := (isLittleO_log_rpow_rpow_atTop (fordDecayExponent + 1) (by norm_num : (0 : ℝ) < 1 / 8)).tendsto_div_nhds_zero apply squeeze_zero' _ _ hu · filter_upwards [tendsto_log_atTop.eventually_ge_atTop 1, eventually_gt_atTop 0] with y hy hy0 have hll : 0 ≤ log (log y) := log_nonneg hy positivity · filter_upwards [tendsto_log_atTop.eventually_ge_atTop 1, eventually_gt_atTop 0] with y hy hy0 have hlog : 0 < log y := by linarith have hll : log (log y) ≤ log y := (log_le_sub_one_of_pos hlog).trans (by linarith) apply div_le_div_of_nonneg_right _ (by positivity) rw [rpow_add hlog, rpow_one] exact mul_le_mul_of_nonneg_left hll (rpow_nonneg hlog.le _) theorem fordPowerfulConvolutionEnvelope_scaled_tendsto_zero : Tendsto (fun y : ℝ ↦ (log y) ^ fordDecayExponent * fordPowerfulConvolutionEnvelope y) atTop (𝓝 0) := by have h := (fordRadicalShiftEnvelope_scaled_tendsto_zero.const_mul ((768 : ℝ) ^ 4 * fordPowerfulTailConstant)).add (ford_powerful_tail_scaled_tendsto_zero.const_mul fordPowerfulTailConstant) simp only [mul_zero, add_zero] at h apply h.congr intro y unfold fordPowerfulConvolutionEnvelope ring /-- The restored prime-power error remains negligible after the dyadic logarithmic loss. -/ theorem fordPowerfulConvolutionEnvelope_log_scaled_tendsto_zero : Tendsto (fun y : ℝ ↦ (log y) ^ fordDecayExponent * log (log y) * fordPowerfulConvolutionEnvelope y) atTop (𝓝 0) := by have h := (fordRadicalShiftEnvelope_log_scaled_tendsto_zero.const_mul ((768 : ℝ) ^ 4 * fordPowerfulTailConstant)).add (ford_powerful_tail_log_scaled_tendsto_zero.const_mul fordPowerfulTailConstant) simp only [mul_zero, add_zero] at h apply h.congr intro y unfold fordPowerfulConvolutionEnvelope ring end Erdos859Verification end /- Inlined development module: FordPowerfulShiftEnvelope.lean -/ section /- One uniform envelope for the subsequent dyadic divisor-interval union. -/ open Finset Real Filter open scoped Topology Classical namespace Erdos859Verification theorem fordRadicalShiftEnvelope_antitone {y z : ℝ} (hy : 4 ≤ y) (hlarge : 2 * log 2 ≤ log (log y)) (hyz : y ≤ z) : fordRadicalShiftEnvelope z ≤ fordRadicalShiftEnvelope y := by have h2 : 0 < log (2 : ℝ) := log_pos (by norm_num) have hlogy : 0 < log y := log_pos (by linarith) have hlogz : 0 < log z := log_pos (by linarith) have hlogs : log y ≤ log z := log_le_log (by linarith) hyz have hlly : 0 < log (log y) := by linarith have hlls : log (log y) ≤ log (log z) := log_le_log hlogy hlogs have hllz : 0 < log (log z) := hlly.trans_le hlls have hnum : 2 * log 2 * (log z) ^ (-fordUpperExponent) + fordRadicalShiftNumeratorConstant / (log (log z)) ^ (5 / 4 : ℝ) ≤ 2 * log 2 * (log y) ^ (-fordUpperExponent) + fordRadicalShiftNumeratorConstant / (log (log y)) ^ (5 / 4 : ℝ) := by apply add_le_add · exact mul_le_mul_of_nonneg_left (rpow_le_rpow_of_nonpos hlogy hlogs (neg_nonpos.mpr fordUpperExponent_pos.le)) (by positivity) · exact div_le_div₀ fordRadicalShiftNumeratorConstant_pos.le le_rfl (by positivity) (rpow_le_rpow hlly.le hlls (by norm_num)) have hden : (log y) ^ fordDecayExponent ≤ (log z) ^ fordDecayExponent := rpow_le_rpow hlogy.le hlogs fordDecayExponent_pos.le have hEz : 0 ≤ fordRadicalShiftEnvelope z := fordRadicalShiftEnvelope_nonneg (hy.trans hyz) (hlarge.trans hlls) have hscaled (a : ℝ) (ha : 0 < log a) : (log a) ^ fordDecayExponent * fordRadicalShiftEnvelope a = (4 * fordRadicalSupportConstant) * (2 * log 2 * (log a) ^ (-fordUpperExponent) + fordRadicalShiftNumeratorConstant / (log (log a)) ^ (5 / 4 : ℝ)) := by unfold fordRadicalShiftEnvelope rw [← mul_assoc, ford_critical_scaling_identity ha] apply (mul_le_mul_iff_right₀ (rpow_pos_of_pos hlogy fordDecayExponent)).mp calc _ ≤ (log z) ^ fordDecayExponent * fordRadicalShiftEnvelope z := mul_le_mul_of_nonneg_right hden hEz _ ≤ (log y) ^ fordDecayExponent * fordRadicalShiftEnvelope y := by rw [hscaled z hlogz, hscaled y hlogy] exact mul_le_mul_of_nonneg_left hnum (by positivity [fordRadicalSupportConstant_pos]) theorem fordPowerfulConvolutionEnvelope_nonneg {y : ℝ} (hy : 4 ≤ y) (hlarge : 2 * log 2 ≤ log (log y)) : 0 ≤ fordPowerfulConvolutionEnvelope y := by have hE := fordRadicalShiftEnvelope_nonneg hy hlarge have hC := fordPowerfulTailConstant_pos unfold fordPowerfulConvolutionEnvelope positivity theorem fordPowerfulConvolutionEnvelope_antitone {y z : ℝ} (hy : 4 ≤ y) (hlarge : 2 * log 2 ≤ log (log y)) (hyz : y ≤ z) : fordPowerfulConvolutionEnvelope z ≤ fordPowerfulConvolutionEnvelope y := by unfold fordPowerfulConvolutionEnvelope apply add_le_add · exact mul_le_mul_of_nonneg_left (fordRadicalShiftEnvelope_antitone hy hlarge hyz) (by positivity [fordPowerfulTailConstant_pos]) · exact div_le_div₀ fordPowerfulTailConstant_pos.le le_rfl (by positivity) (rpow_le_rpow (by linarith) hyz (by norm_num)) noncomputable def fordPowerfulDyadicEnvelope (t : ℝ) : ℝ := fordPowerfulConvolutionEnvelope (sqrt t) theorem fordPowerfulDyadicEnvelope_eventual_nonneg : ∀ᶠ t : ℝ in atTop, 0 ≤ fordPowerfulDyadicEnvelope t := by filter_upwards [tendsto_sqrt_atTop.eventually_ge_atTop 4, ((tendsto_log_atTop.comp tendsto_log_atTop).comp tendsto_sqrt_atTop).eventually_ge_atTop (2 * log 2)] with t ht hll exact fordPowerfulConvolutionEnvelope_nonneg ht hll /-- All finite powerful-factor convolutions at all endpoints above `sqrt t` are bounded by the same quantitative envelope. -/ theorem fordPowerfulConvolution_eventual_uniform_dyadic_upper : ∀ᶠ t : ℝ in atTop, ∀ y : ℝ, sqrt t ≤ y → ∀ T : Finset ℕ, (∀ B ∈ T, FordPowerful B) → fordPowerfulConvolution T y ≤ fordPowerfulDyadicEnvelope t := by obtain ⟨y0, hy0⟩ := eventually_atTop.mp fordPowerfulConvolution_eventual_upper filter_upwards [tendsto_sqrt_atTop.eventually_ge_atTop y0, tendsto_sqrt_atTop.eventually_ge_atTop 4, ((tendsto_log_atTop.comp tendsto_log_atTop).comp tendsto_sqrt_atTop).eventually_ge_atTop (2 * log 2)] with t ht h4 hll intro y hy T hT exact (hy0 y (ht.trans hy) T hT).trans (fordPowerfulConvolutionEnvelope_antitone h4 hll hy) theorem ford_sqrt_log_scaling_identity {t : ℝ} (ht : 1 < t) (E : ℝ) : (log t) ^ fordDecayExponent * log (log t) * E = (2 : ℝ) ^ fordDecayExponent * ((log (sqrt t)) ^ fordDecayExponent * log (log (sqrt t)) * E + log 2 * ((log (sqrt t)) ^ fordDecayExponent * E)) := by have hlog : 0 < log t := log_pos ht have htwo : (2 : ℝ) ^ fordDecayExponent ≠ 0 := (rpow_pos_of_pos (by norm_num) _).ne' rw [log_sqrt (by linarith : 0 ≤ t), log_div hlog.ne' (by norm_num : (2 : ℝ) ≠ 0), div_rpow hlog.le (by norm_num)] field_simp ring /-- The envelope absorbs the extra logarithmic number of dyadic intervals. -/ theorem fordPowerfulDyadicEnvelope_log_scaled_tendsto_zero : Tendsto (fun t : ℝ ↦ (log t) ^ fordDecayExponent * log (log t) * fordPowerfulDyadicEnvelope t) atTop (𝓝 0) := by have hstrong := fordPowerfulConvolutionEnvelope_log_scaled_tendsto_zero.comp tendsto_sqrt_atTop have hplain := fordPowerfulConvolutionEnvelope_scaled_tendsto_zero.comp tendsto_sqrt_atTop have h := (hstrong.add (hplain.const_mul (log 2))).const_mul ((2 : ℝ) ^ fordDecayExponent) simp only [mul_zero, add_zero] at h apply h.congr' filter_upwards [eventually_gt_atTop (1 : ℝ)] with t ht exact (ford_sqrt_log_scaling_identity ht (fordPowerfulConvolutionEnvelope (sqrt t))).symm end Erdos859Verification end /- Inlined development module: PrimePowerfulDivisorSplit.lean -/ section /- Deterministic powerful/squarefree decomposition of a finite exponent state. -/ namespace Erdos859Verification open Finset open scoped Classical def powerfulExponentSet (P : Finset ℕ) (e : ℕ → ℕ) : Finset ℕ := P.filter (fun p ↦ 2 ≤ e p) def singletonExponentSet (P : Finset ℕ) (e : ℕ → ℕ) : Finset ℕ := P.filter (fun p ↦ e p = 1) def powerfulExponentPart (P : Finset ℕ) (e : ℕ → ℕ) : ℕ := powerfulPartNumber (powerfulExponentSet P e) e theorem prime_exponent_product_split (P : Finset ℕ) (e : ℕ → ℕ) : (∏ p ∈ P, p^e p) = powerfulExponentPart P e * ∏ p ∈ singletonExponentSet P e, p := by have hp (p : ℕ) : p^e p = (if 2≤e p then p^e p else 1) * (if e p=1 then p else 1) := by by_cases he2 : 2≤e p · simp [he2, show e p≠1 by omega] · by_cases he1 : e p=1 · simp [he1] · have he0 : e p=0 := by omega simp [he0] calc _ = ∏ p ∈ P, (if 2≤e p then p^e p else 1) * (if e p=1 then p else 1) := prod_congr rfl (fun p _ ↦ hp p) _ = _ := by rw [prod_mul_distrib] simp only [prod_ite, prod_const_one, mul_one] rfl theorem singletonExponentSet_subset_complement (P : Finset ℕ) (e : ℕ → ℕ) : singletonExponentSet P e ⊆ P \ powerfulExponentSet P e := by intro p hp obtain ⟨hpP, he⟩ := mem_filter.mp hp exact mem_sdiff.mpr ⟨hpP, by simp [powerfulExponentSet, he]⟩ theorem powerfulPartNumber_factorization {H : Finset ℕ} (hH : ∀ p ∈ H, p.Prime) (a : ℕ → ℕ) (q : ℕ) : (powerfulPartNumber H a).factorization q = if q ∈ H then a q else 0 := by unfold powerfulPartNumber rw [Nat.factorization_prod_apply (fun p hp ↦ pow_ne_zero _ (hH p hp).ne_zero)] calc _ = ∑ p ∈ H, if q=p then a p else 0 := by apply sum_congr rfl intro p hp rw [(hH p hp).factorization_pow] simp only [Finsupp.single_apply, eq_comm] _ = _ := by simp theorem powerfulPartNumber_primeFactors {H : Finset ℕ} (hH : ∀ p ∈ H, p.Prime) (a : ℕ → ℕ) (ha : ∀ p ∈ H, 0 have hd1 : d=1 := Nat.dvd_one.mp (by simpa using hd) exact ⟨∅, subset_rfl, by simp [hd1]⟩ | @insert p T hp ih => have hpprime := hT p (mem_insert_self p T) have hT' : ∀ q∈T,q.Prime := fun q hq ↦ hT q (mem_insert_of_mem hq) rw [prod_insert hp] at hd obtain ⟨a,b,ha,hb,rfl⟩ := exists_dvd_and_dvd_of_dvd_mul hd obtain ⟨U,hU,hprod⟩ := ih hT' hb rcases (Nat.dvd_prime hpprime).mp ha with ha1 | hap · subst a exact ⟨U,hU.trans (subset_insert _ _),by simpa using hprod⟩ · subst a have hpU : p∉U := fun hm ↦ hp (hU hm) exact ⟨insert p U,insert_subset_insert p hU,by rw [prod_insert hpU,hprod]⟩ def FordRealDivisorEvent (y : ℝ) (n : ℕ) : Prop := ∃ d : ℕ, y < (d:ℝ) ∧ (d:ℝ) ≤ 2*y ∧ d ∣ n theorem real_divisor_event_mul_radical_split {B : ℕ} (hB : 0 norm_num theorem fordDivisorRadicalObservable_nonneg (B : ℕ) (y : ℝ) (T : Finset ℕ) : 0 ≤ fordDivisorRadicalObservable B y T := sum_nonneg (fun _ _ ↦ by split_ifs <;> norm_num) theorem fordDivisorRadicalObservable_monotone (B : ℕ) (y : ℝ) : Monotone (fordDivisorRadicalObservable B y) := by intro S T hST exact sum_le_sum (fun f _ ↦ fordRadicalIndicator_monotone (y/(f:ℝ)) hST) theorem prime_expectation_divisorRadicalObservable (P : Finset ℕ) (B : ℕ) (y : ℝ) : (∑ T∈P.powerset,primePatternWeight P T * fordDivisorRadicalObservable B y T) = ∑ f∈B.divisors,finiteRadicalEventMass P (y/(f:ℝ)) := by simp only [fordDivisorRadicalObservable, mul_sum] rw [sum_comm] simp only [finiteRadicalEventMass, sum_filter, mul_ite, mul_one, mul_zero] theorem cappedPowerfulFiber_divisor_event_le {P : Finset ℕ} (hP : ∀ p∈P,p.Prime) (cap : ℕ → ℕ) (hcap : ∀ p∈P,2≤cap p) {B : ℕ} (hB : B∈cappedPowerfulValues P cap) (y : ℝ) : (∑ e∈univ.filter (fun e : CappedPrimeState P cap ↦ cappedStatePowerfulPart P cap e=B), if FordRealDivisorEvent y (cappedPrimeStateProduct P cap e) then cappedPrimeStateWeight P cap e else 0) ≤ (1/(B:ℝ)) * ∑ f∈B.divisors,finiteRadicalEventMass P (y/(f:ℝ)) := by calc _ ≤ ∑ e∈univ.filter (fun e : CappedPrimeState P cap ↦ cappedStatePowerfulPart P cap e=B), cappedPrimeStateWeight P cap e * fordDivisorRadicalObservable B y (cappedStateSingletons P cap e) := by apply sum_le_sum intro e he by_cases hE : FordRealDivisorEvent y (cappedPrimeStateProduct P cap e) · rw [if_pos hE] obtain ⟨f,hf,hgood⟩ := cappedState_powerful_divisor_split hP cap e hE rw [(mem_filter.mp he).2] at hf have hobs : 1 ≤ fordDivisorRadicalObservable B y (cappedStateSingletons P cap e) := by have h := single_le_sum (f := fun f : ℕ ↦ if FordRadicalDivisorEvent (y/(f:ℝ)) (cappedStateSingletons P cap e) then (1:ℝ) else 0) (fun _ _ ↦ by split_ifs <;> norm_num) hf simpa only [fordDivisorRadicalObservable, if_pos hgood] using h simpa only [mul_one] using mul_le_mul_of_nonneg_left hobs (cappedPrimeStateWeight_nonneg hP cap e) · rw [if_neg hE] exact mul_nonneg (cappedPrimeStateWeight_nonneg hP cap e) (fordDivisorRadicalObservable_nonneg _ _ _) _ ≤ (1/(B:ℝ)) * ∑ T∈P.powerset,primePatternWeight P T * fordDivisorRadicalObservable B y T := cappedPowerfulFiber_expectation_le hP cap hcap hB _ (fordDivisorRadicalObservable_monotone B y) (fordDivisorRadicalObservable_nonneg B y) _ = _ := by rw [prime_expectation_divisorRadicalObservable] theorem cappedState_divisor_event_mass_le {P : Finset ℕ} (hP : ∀ p∈P,p.Prime) (cap : ℕ → ℕ) (hcap : ∀ p∈P,2≤cap p) (y : ℝ) : (∑ e∈univ.filter (fun e : CappedPrimeState P cap ↦ FordRealDivisorEvent y (cappedPrimeStateProduct P cap e)),cappedPrimeStateWeight P cap e) ≤ ∑ B∈cappedPowerfulValues P cap, (1/(B:ℝ)) * ∑ f∈B.divisors,finiteRadicalEventMass P (y/(f:ℝ)) := by rw [sum_filter] rw [← sum_fiberwise_of_maps_to (fun e (_ : e∈(univ : Finset (CappedPrimeState P cap))) ↦ show cappedStatePowerfulPart P cap e∈cappedPowerfulValues P cap from mem_image.mpr ⟨e,mem_univ _,rfl⟩)] exact sum_le_sum (fun B hB ↦ cappedPowerfulFiber_divisor_event_le hP cap hcap hB y) /-- Large powerful parts use total fiber mass, avoiding a divisor-count factor in the tail. -/ theorem cappedState_divisor_event_mass_truncated {P : Finset ℕ} (hP : ∀ p∈P,p.Prime) (cap : ℕ → ℕ) (hcap : ∀ p∈P,2≤cap p) (y L : ℝ) : (∑ e∈univ.filter (fun e : CappedPrimeState P cap ↦ FordRealDivisorEvent y (cappedPrimeStateProduct P cap e)),cappedPrimeStateWeight P cap e) ≤ (∑ B∈(cappedPowerfulValues P cap).filter (fun B : ℕ ↦ (B:ℝ)≤L), (1/(B:ℝ)) * ∑ f∈B.divisors,finiteRadicalEventMass P (y/(f:ℝ))) + ∑ B∈(cappedPowerfulValues P cap).filter (fun B : ℕ ↦ L<(B:ℝ)),1/(B:ℝ) := by rw [sum_filter] rw [← sum_fiberwise_of_maps_to (fun e (_ : e∈(univ : Finset (CappedPrimeState P cap))) ↦ show cappedStatePowerfulPart P cap e∈cappedPowerfulValues P cap from mem_image.mpr ⟨e,mem_univ _,rfl⟩)] calc _ ≤ ∑ B∈cappedPowerfulValues P cap, if (B:ℝ)≤L then (1/(B:ℝ))*∑ f∈B.divisors,finiteRadicalEventMass P (y/(f:ℝ)) else 1/(B:ℝ) := by apply sum_le_sum intro B hB by_cases hsmall : (B:ℝ)≤L · rw [if_pos hsmall] exact cappedPowerfulFiber_divisor_event_le hP cap hcap hB y · rw [if_neg hsmall] apply le_trans _ (cappedPowerfulFiber_mass_le hP cap hcap hB) exact sum_le_sum (fun e _ ↦ by split_ifs · rfl · exact cappedPrimeStateWeight_nonneg hP cap e) _ = _ := by simp only [sum_filter, ←sum_add_distrib] apply sum_congr rfl intro B _ by_cases hsmall : (B:ℝ)≤L · simp [hsmall, not_lt_of_ge hsmall] · simp [hsmall, lt_of_not_ge hsmall] theorem cappedState_divisor_event_mass_truncated_tail {P : Finset ℕ} (hP : ∀ p∈P,p.Prime) (cap : ℕ → ℕ) (hcap : ∀ p∈P,2≤cap p) (y : ℝ) {L : ℝ} (hL : 0 first | rfl | dsimp [coreAnchorEndpointFactor]; ring /-- One eventual threshold works for every actual core and every completed block from block five through the final block. -/ theorem coreRateProperCore_anchor_size_eventually {eta c : ℝ} (hc : (501 / 500 : ℝ) * exp eta < c) : ∀ᶠ s : ℕ in atTop, ∀ T : Finset ℕ, CoreRateProperCore eta s T → ∀ b : ℕ, 5 ≤ b → b ≤ coreRateBlockCount s → (corePhaseParameter (coreRateTotalLength s) : ℝ) * (∑ U : DivisorCubeCoordinate (coreAnchorPrefix T s b), divisorCubeWeight (coreAnchorPrefix T s b) U : ℕ) ≤ coreAnchorCubeSize s (b * coreRateBlockLength s) ^ c := by have hc0 : 0 ≤ c := (show 0 < (501 / 500 : ℝ) * exp eta by positivity).le.trans hc.le filter_upwards [coreRateLength_eventually_split, (coreAnchorCoefficient_tendsto eta).eventually_lt_const hc] with s hs hcoeff intro T hevent b hb0 hb have h := (hevent.anchor_log_size hs.2 hb0 hb).trans (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right hcoeff.le (sq_nonneg _)) (by positivity)) rw [mul_assoc] at h have hlog := h.trans (mul_le_mul_of_nonneg_left (coreAnchorCubeSize_log_lower s (b * coreRateBlockLength s)) hc0) have hY : (0 : ℝ) < corePhaseParameter (coreRateTotalLength s) := by exact_mod_cast corePhaseParameter_pos _ have hW : (0 : ℝ) < (∑ U : DivisorCubeCoordinate (coreAnchorPrefix T s b), divisorCubeWeight (coreAnchorPrefix T s b) U : ℕ) := by rw [sum_divisorCubeWeight, Nat.cast_prod] exact prod_pos fun p _ ↦ by positivity apply (log_le_log_iff (mul_pos hY hW) (rpow_pos_of_pos (coreAnchorCubeSize_pos _ _) _)).mp rw [log_rpow (coreAnchorCubeSize_pos _ _)] exact hlog end Erdos859Verification end /- Inlined development module: CoreAnchorInitialScale.lean -/ section /- The first anchor has negligible logarithm compared with the available number of prime tests times the logarithm of the phase parameter. -/ open Finset Filter Real open scoped Topology namespace Erdos859Verification noncomputable def corePhaseMarkCount (k : ℕ) : ℕ := ⌈(k : ℝ) ^ (3 / 4 : ℝ)⌉₊ theorem corePhaseMarkCount_pos {k : ℕ} (hk : 0 < k) : 0 < corePhaseMarkCount k := by have hkR : (0 : ℝ) < k := by exact_mod_cast hk have h : (0 : ℝ) < corePhaseMarkCount k := (rpow_pos_of_pos hkR _).trans_le (Nat.le_ceil _) exact_mod_cast h theorem corePhaseParameter_log_lower (k : ℕ) : (k : ℝ) ^ 3 ≤ log (corePhaseParameter k : ℝ) := (log_ceil_exp_bounds (show 0 ≤ (k : ℝ) ^ 3 by positivity)).1 theorem corePhaseMarkCount_ge_block_power (s : ℕ) : (2 : ℝ) ^ (3 * coreRateBlockLength s) ≤ corePhaseMarkCount (coreRateTotalLength s) := by have hbase : (2 : ℝ) ^ (4 * coreRateBlockLength s) ≤ coreRateTotalLength s := by have hH : (1 : ℝ) ≤ coreRateBlockLength s := by exact_mod_cast coreRateBlockLength_pos s simp only [coreRateTotalLength, coreRateBlockCount, Nat.cast_mul, Nat.cast_pow, Nat.cast_ofNat] exact le_mul_of_one_le_left (by positivity) hH have hpow := rpow_le_rpow (by positivity) hbase (by norm_num : (0 : ℝ) ≤ 3 / 4) have hid : ((2 : ℝ) ^ (4 * coreRateBlockLength s)) ^ (3 / 4 : ℝ) = (2 : ℝ) ^ (3 * coreRateBlockLength s) := by rw [← rpow_natCast_mul (by norm_num : (0 : ℝ) ≤ 2)] have he : ((4 * coreRateBlockLength s : ℕ) : ℝ) * (3 / 4 : ℝ) = ((3 * coreRateBlockLength s : ℕ) : ℝ) := by push_cast; ring rw [he, rpow_natCast] rw [hid] at hpow exact hpow.trans (Nat.le_ceil _) theorem coreAnchorCubeSize_log_upper {s t : ℕ} : log (coreAnchorCubeSize s t) ≤ 9 * (coreRateTotalLength s : ℝ) ^ 2 * (2 : ℝ) ^ t := by have hk : (1 : ℝ) ≤ coreRateTotalLength s := by exact_mod_cast coreRateTotalLength_pos s have hb : log ((2 * coreProperCap (coreRateTotalLength s) + 1 : ℕ) : ℝ) ≤ (coreRateTotalLength s : ℝ) ^ 2 + 8 := by apply (log_le_log (by positivity) (show ((2 * coreProperCap (coreRateTotalLength s) + 1 : ℕ) : ℝ) ≤ ((4 * coreProperCap (coreRateTotalLength s) + 1 : ℕ) : ℝ) by push_cast have hc : (0 : ℝ) ≤ coreProperCap (coreRateTotalLength s) := Nat.cast_nonneg _ linarith)).trans exact coreProperCap_log_difference_base_le _ rw [coreAnchorCubeSize_log] exact mul_le_mul_of_nonneg_right (hb.trans (by nlinarith)) (by positivity) theorem coreAnchorInitial_ratio_bound (s : ℕ) : log (coreAnchorCubeSize s (5 * coreRateBlockLength s)) / ((corePhaseMarkCount (coreRateTotalLength s) : ℝ) * log (corePhaseParameter (coreRateTotalLength s) : ℝ)) ≤ 9 / (2 : ℝ) ^ (2 * coreRateBlockLength s) := by let h := coreRateBlockLength s let k := coreRateTotalLength s have hh : (1 : ℝ) ≤ h := by exact_mod_cast coreRateBlockLength_pos s have hk : (0 : ℝ) < k := by exact_mod_cast coreRateTotalLength_pos s have hden : (2 : ℝ) ^ (3 * h) * (k : ℝ) ^ 3 ≤ (corePhaseMarkCount k : ℝ) * log (corePhaseParameter k : ℝ) := mul_le_mul (corePhaseMarkCount_ge_block_power s) (corePhaseParameter_log_lower k) (by positivity) (Nat.cast_nonneg _) have hden0 : 0 < (2 : ℝ) ^ (3 * h) * (k : ℝ) ^ 3 := by positivity have hnum0 : 0 ≤ log (coreAnchorCubeSize s (5 * h)) := (show 0 ≤ (k : ℝ) ^ 2 * (2 : ℝ) ^ (5 * h) by positivity).trans (coreAnchorCubeSize_log_lower _ _) calc _ ≤ log (coreAnchorCubeSize s (5 * h)) / ((2 : ℝ) ^ (3 * h) * (k : ℝ) ^ 3) := div_le_div_of_nonneg_left hnum0 hden0 hden _ ≤ (9 * (k : ℝ) ^ 2 * (2 : ℝ) ^ (5 * h)) / ((2 : ℝ) ^ (3 * h) * (k : ℝ) ^ 3) := div_le_div_of_nonneg_right coreAnchorCubeSize_log_upper hden0.le _ = 9 / ((h : ℝ) * (2 : ℝ) ^ (2 * h)) := by have hh0 : (h : ℝ) ≠ 0 := ne_of_gt (by linarith) dsimp [k, coreRateTotalLength, coreRateBlockCount] push_cast change (9 * ((h : ℝ) * (2 : ℝ) ^ (4 * h)) ^ 2 * (2 : ℝ) ^ (5 * h)) / ((2 : ℝ) ^ (3 * h) * ((h : ℝ) * (2 : ℝ) ^ (4 * h)) ^ 3) = _ rw [show 5 * h = 3 * h + 2 * h by omega, pow_add, show 4 * h = 2 * h + 2 * h by omega, pow_add] field_simp _ ≤ 9 / (2 : ℝ) ^ (2 * h) := div_le_div_of_nonneg_left (by norm_num) (by positivity) (le_mul_of_one_le_left (by positivity) hh) /-- In particular the logarithm of the first denominator cutoff is negligible relative to the small-denominator testing exponent `m * log Y`. -/ theorem coreAnchorInitial_ratio_tendsto : Tendsto (fun s ↦ log (coreAnchorCubeSize s (5 * coreRateBlockLength s)) / ((corePhaseMarkCount (coreRateTotalLength s) : ℝ) * log (corePhaseParameter (coreRateTotalLength s) : ℝ))) atTop (𝓝 0) := by have hgeom := (tendsto_pow_atTop_nhds_zero_of_lt_one (by norm_num : (0 : ℝ) ≤ 1 / 4) (by norm_num : (1 : ℝ) / 4 < 1)).comp coreRateBlockLength_tendsto apply squeeze_zero (fun s ↦ ?_) coreAnchorInitial_ratio_bound (by simpa only [Function.comp_def, pow_mul, show (2 : ℝ) ^ 2 = 4 by norm_num, div_pow, one_pow, mul_zero, div_eq_mul_inv, inv_pow, one_mul] using hgeom.const_mul 9) apply div_nonneg · exact (show 0 ≤ (coreRateTotalLength s : ℝ) ^ 2 * (2 : ℝ) ^ (5 * coreRateBlockLength s) by positivity).trans (coreAnchorCubeSize_log_lower _ _) · exact mul_nonneg (Nat.cast_nonneg _) ((by positivity : 0 ≤ (coreRateTotalLength s : ℝ) ^ 3).trans (corePhaseParameter_log_lower _)) end Erdos859Verification end /- Inlined development module: LogMeshHarmonic.lean -/ section /- Many separated mesh divisors supply a harmonic mass proportional to their number. -/ open Finset Real open scoped Classical namespace Erdos859Verification def quarterTargetInterval (N : ℕ) : Finset ℕ := Icc (N / 4 + 1) (3 * N / 4) theorem quarterTargetInterval_disjoint {N M : ℕ} (h : 3 * N < M) : Disjoint (quarterTargetInterval N) (quarterTargetInterval M) := by apply disjoint_left.mpr intro t ht ht' obtain ⟨_, hhi⟩ := mem_Icc.mp ht obtain ⟨hlo, _⟩ := mem_Icc.mp ht' omega theorem quarterTargetInterval_family_harmonic {n : ℕ} (N : Fin n → ℕ) (hN : ∀ i, 4 ≤ N i) (hsep : ∀ i j, i < j → 4 * N i ≤ N j) : (n : ℝ) / 4 ≤ ∑ t ∈ univ.biUnion (fun i ↦ quarterTargetInterval (N i)), 1 / (t : ℝ) := by have hdis : ∀ i ∈ (univ : Finset (Fin n)), ∀ j ∈ univ, i ≠ j → Disjoint (quarterTargetInterval (N i)) (quarterTargetInterval (N j)) := by intro i _ j _ hij rcases lt_or_gt_of_ne hij with hlt | hgt · exact quarterTargetInterval_disjoint (by have := hsep i j hlt; have := hN i; omega) · exact (quarterTargetInterval_disjoint (by have := hsep j i hgt; have := hN j; omega)).symm rw [sum_biUnion hdis] calc _ = ∑ _i : Fin n, (1 : ℝ) / 4 := by simp [div_eq_mul_inv] _ ≤ _ := sum_le_sum (fun i _ ↦ quarter_interval_harmonic_mass (hN i)) theorem exists_separated_logMesh_points {R : Finset ℕ} {a b g : ℝ} {n : ℕ} (hg : 0 ≤ g) (hstep : (n : ℝ) * (g + log 4) ≤ b - a) (hpos : ∀ r ∈ R, 0 < r) (hmesh : ∀ x : ℝ, a ≤ x → x + g ≤ b → ∃ r ∈ R, x ≤ log (r : ℝ) ∧ log (r : ℝ) ≤ x + g) : ∃ r : Fin n → ℕ, (∀ i, r i ∈ R) ∧ (∀ i, a ≤ log (r i : ℝ) ∧ log (r i : ℝ) ≤ b) ∧ ∀ i j, i < j → 4 * r i ≤ r j := by have hlog4 : 0 < log (4 : ℝ) := log_pos (by norm_num) have hs : 0 < g + log 4 := by linarith have hex : ∀ i : Fin n, ∃ r ∈ R, a + (i.val : ℝ) * (g + log 4) ≤ log (r : ℝ) ∧ log (r : ℝ) ≤ a + (i.val : ℝ) * (g + log 4) + g := by intro i apply hmesh · exact le_add_of_nonneg_right (mul_nonneg (Nat.cast_nonneg i.val) hs.le) · have hin : (i.val : ℝ) + 1 ≤ n := by exact_mod_cast i.isLt have hi := mul_le_mul_of_nonneg_right hin hs.le nlinarith choose r hr hrlo hrhi using hex refine ⟨r, hr, ?_, ?_⟩ · intro i have hin : (i.val : ℝ) + 1 ≤ n := by exact_mod_cast i.isLt have hi := mul_le_mul_of_nonneg_right hin hs.le constructor · exact (le_add_of_nonneg_right (mul_nonneg (Nat.cast_nonneg i.val) hs.le)).trans (hrlo i) · nlinarith [hrhi i] · intro i j hij have hij' : (i.val : ℝ) + 1 ≤ j.val := by exact_mod_cast hij have hi := mul_le_mul_of_nonneg_right hij' hs.le have hlog : log 4 + log (r i : ℝ) ≤ log (r j : ℝ) := by nlinarith [hrhi i, hrlo j] have hipos : (0 : ℝ) < r i := by exact_mod_cast hpos _ (hr i) have hjpos : (0 : ℝ) < r j := by exact_mod_cast hpos _ (hr j) rw [← log_mul (by norm_num : (4 : ℝ) ≠ 0) hipos.ne'] at hlog have hreal := (log_le_log_iff (mul_pos (by norm_num) hipos) hjpos).mp hlog exact_mod_cast hreal /-- Each mesh interval may be represented by any mechanism; only its actual integer targets and the fixed logarithmic horizon enter this conclusion. -/ theorem logMesh_represented_harmonic_mass {R : Finset ℕ} {a b g : ℝ} {n Z : ℕ} (hg : 0 ≤ g) (hstep : (n : ℝ) * (g + log 4) ≤ b - a) (hpos : ∀ r ∈ R, 0 < r) (hmesh : ∀ x : ℝ, a ≤ x → x + g ≤ b → ∃ r ∈ R, x ≤ log (r : ℝ) ∧ log (r : ℝ) ≤ x + g) (hsize : ∀ r ∈ R, 4 ≤ Z * r) (H : Finset ℕ) (E : ℕ → Prop) (hH : ∀ r ∈ R, quarterTargetInterval (Z * r) ⊆ H) (hE : ∀ r ∈ R, ∀ t ∈ quarterTargetInterval (Z * r), E t) : (n : ℝ) / 4 ≤ ∑ t ∈ H.filter E, 1 / (t : ℝ) := by obtain ⟨r, hr, _, hsep⟩ := exists_separated_logMesh_points hg hstep hpos hmesh have hN : ∀ i, 4 ≤ Z * r i := fun i ↦ hsize _ (hr i) have hNsep : ∀ i j, i < j → 4 * (Z * r i) ≤ Z * r j := by intro i j hij simpa only [mul_assoc, mul_left_comm] using Nat.mul_le_mul_left Z (hsep i j hij) apply (quarterTargetInterval_family_harmonic (fun i ↦ Z * r i) hN hNsep).trans apply sum_le_sum_of_subset_of_nonneg · intro t ht obtain ⟨i, _, hti⟩ := mem_biUnion.mp ht exact mem_filter.mpr ⟨hH _ (hr i) hti, hE _ (hr i) _ hti⟩ · intro t _ _ positivity end Erdos859Verification end /- Inlined development module: LowerDensityLiminf.lean -/ section /- The final analytic lower-bound bridge, including the boundedness conditions for the real-valued filter liminf. The arithmetic construction is not assumed to have been completed by this module. -/ open Filter Finset Real open scoped Topology Classical namespace Erdos859Verification theorem log_rate_le_of_exponential_lower {d b a : ℝ} (hb : 1 < b) (h : exp (-a * log b) ≤ d) : -log d / log b ≤ a := by have hd : 0 < d := (exp_pos _).trans_le h have hlog := log_le_log (exp_pos _) h rw [log_exp] at hlog apply (div_le_iff₀ (log_pos hb)).mpr linarith theorem log_rate_eventually_ge_of_scaled_limit {d b : ℕ → ℝ} {a : ℝ} (hd : ∀ᶠ n in atTop, 0 < d n) (hb : Tendsto b atTop atTop) (hscaled : Tendsto (fun n ↦ b n ^ a * d n) atTop (𝓝 0)) : ∀ᶠ n in atTop, a ≤ -log (d n) / log (b n) := by filter_upwards [hd, hb.eventually_gt_atTop 1, hscaled.eventually_lt_const (by norm_num : (0 : ℝ) < 1)] with n hdn hbn hs have hbn0 : 0 < b n := by linarith have hp : 0 < b n ^ a := rpow_pos_of_pos hbn0 a have hlog := log_le_log (mul_pos hp hdn) hs.le rw [log_one, log_mul hp.ne' hdn.ne', log_rpow hbn0] at hlog apply (le_div_iff₀ (log_pos hbn)).mpr nlinarith /-- Frequent near-critical lower bounds provide the otherwise essential upper coboundedness of the logarithmic rate. -/ theorem log_rate_liminf_eq_of_frequent_lower {d b : ℕ → ℝ} {a : ℝ} (hd : ∀ᶠ n in atTop, 0 < d n) (hb : Tendsto b atTop atTop) (hscaled : Tendsto (fun n ↦ b n ^ a * d n) atTop (𝓝 0)) (hlower : ∀ eps : ℝ, 0 < eps → ∃ᶠ n in atTop, exp (-(a + eps) * log (b n)) ≤ d n) : atTop.liminf (fun n ↦ -log (d n) / log (b n)) = a := by have hge := log_rate_eventually_ge_of_scaled_limit hd hb hscaled have hbounded : atTop.IsBoundedUnder (· ≥ ·) (fun n ↦ -log (d n) / log (b n)) := ⟨a, hge⟩ have hfreq (eps : ℝ) (heps : 0 < eps) : ∃ᶠ n in atTop, -log (d n) / log (b n) ≤ a + eps := by exact ((hlower eps heps).and_eventually (hb.eventually_gt_atTop 1)).mono fun n hn ↦ log_rate_le_of_exponential_lower hn.2 hn.1 have hcobounded : atTop.IsCoboundedUnder (· ≥ ·) (fun n ↦ -log (d n) / log (b n)) := IsCoboundedUnder.of_frequently_le (hfreq 1 (by norm_num)) apply le_antisymm · apply le_of_forall_pos_le_add intro eps heps exact liminf_le_of_frequently_le (hfreq eps heps) hbounded · exact le_liminf_of_le hcobounded hge /-- A lower theorem for arbitrarily large targets is enough; no estimate for every sufficiently large target is required. -/ theorem divisorDensity_liminf_eq_of_frequent_lower (hscaled : Tendsto (fun t : ℕ ↦ log (t : ℝ) ^ delta * divisorDensity t) atTop (𝓝 0)) (hlower : ∀ eps : ℝ, 0 < eps → ∃ᶠ t : ℕ in atTop, exp (-(delta + eps) * log (log (t : ℝ))) ≤ divisorDensity t) : atTop.liminf (fun t : ℕ ↦ -log (divisorDensity t) / log (log (t : ℝ))) = delta := log_rate_liminf_eq_of_frequent_lower (Eventually.of_forall divisorDensity_pos) (tendsto_log_atTop.comp tendsto_natCast_atTop_atTop) hscaled hlower theorem finite_positive_weight_average_exists {α : Type*} (S : Finset α) (hS : S.Nonempty) (w d : α → ℝ) (hw : ∀ t ∈ S, 0 < w t) {c : ℝ} (hmean : c * (∑ t ∈ S, w t) ≤ ∑ t ∈ S, w t * d t) : ∃ t ∈ S, c ≤ d t := by have hsum : (∑ t ∈ S, w t * c) ≤ ∑ t ∈ S, w t * d t := by simpa only [← sum_mul, mul_comm c] using hmean obtain ⟨t, ht, htd⟩ := exists_le_of_sum_le hS hsum exact ⟨t, ht, (mul_le_mul_iff_right₀ (hw t ht)).mp htd⟩ theorem finite_horizon_log_rate_exists (S : Finset ℕ) (hS : S.Nonempty) (w d b : ℕ → ℝ) (hw : ∀ t ∈ S, 0 < w t) {H a : ℝ} (hH : 0 < H) (ha : 0 ≤ a) (hscale : ∀ t ∈ S, H ≤ log (b t)) (hmean : exp (-a * H) * (∑ t ∈ S, w t) ≤ ∑ t ∈ S, w t * d t) : ∃ t ∈ S, -log (d t) / log (b t) ≤ a := by obtain ⟨t, ht, htd⟩ := finite_positive_weight_average_exists S hS w d hw hmean have hlogb : 0 < log (b t) := hH.trans_le (hscale t ht) have hlog := log_le_log (exp_pos _) htd rw [log_exp] at hlog refine ⟨t, ht, (div_le_iff₀ hlogb).mpr ?_⟩ have hmul := mul_le_mul_of_nonneg_left (hscale t ht) ha linarith /-- A sequence of finite horizons need only escape to infinity. It need not cover every sufficiently large target or have bounded gaps. -/ theorem frequent_log_rate_of_finite_horizons (S : ℕ → Finset ℕ) (w : ℕ → ℕ → ℝ) (d b : ℕ → ℝ) (H : ℕ → ℝ) {a : ℝ} (ha : 0 ≤ a) (hescape : ∀ N : ℕ, ∀ᶠ k : ℕ in atTop, ∀ t ∈ S k, N ≤ t) (hfinite : ∀ᶠ k : ℕ in atTop, (S k).Nonempty ∧ (∀ t ∈ S k, 0 < w k t) ∧ 0 < H k ∧ (∀ t ∈ S k, H k ≤ log (b t)) ∧ exp (-a * H k) * (∑ t ∈ S k, w k t) ≤ ∑ t ∈ S k, w k t * d t) : ∃ᶠ t : ℕ in atTop, -log (d t) / log (b t) ≤ a := by apply frequently_atTop.mpr intro N obtain ⟨k, hk, hN⟩ := (hfinite.and (hescape N)).exists obtain ⟨t, ht, hrate⟩ := finite_horizon_log_rate_exists (S k) hk.1 (w k) d b hk.2.1 hk.2.2.1 ha hk.2.2.2.1 hk.2.2.2.2 exact ⟨t, hN t ht, hrate⟩ theorem divisorDensity_liminf_eq_of_frequent_rates (hscaled : Tendsto (fun t : ℕ ↦ log (t : ℝ) ^ delta * divisorDensity t) atTop (𝓝 0)) (hlower : ∀ eps : ℝ, 0 < eps → ∃ᶠ t : ℕ in atTop, -log (divisorDensity t) / log (log (t : ℝ)) ≤ delta + eps) : atTop.liminf (fun t : ℕ ↦ -log (divisorDensity t) / log (log (t : ℝ))) = delta := by apply divisorDensity_liminf_eq_of_frequent_lower hscaled intro eps heps have hloglog : Tendsto (fun t : ℕ ↦ log (log (t : ℝ))) atTop atTop := tendsto_log_atTop.comp (tendsto_log_atTop.comp tendsto_natCast_atTop_atTop) exact ((hlower eps heps).and_eventually (hloglog.eventually_gt_atTop 0)).mono fun t ht ↦ by have h := (div_le_iff₀ ht.2).mp ht.1 exact (le_log_iff_exp_le (divisorDensity_pos t)).mp (by linarith) /-- The checked optimization of the tilt and Hölder parameters reduces the entire remaining lower construction to frequent fixed-parameter rate bounds. -/ theorem divisorDensity_liminf_eq_of_transfer_rates (hscaled : Tendsto (fun t : ℕ ↦ log (t : ℝ) ^ delta * divisorDensity t) atTop (𝓝 0)) (htransfer : ∀ lam : ℝ, criticalTilt < lam → lam < 2 → ∀ q : ℝ, 1 < q → ∀ eps : ℝ, 0 < eps → ∃ᶠ t : ℕ in atTop, -log (divisorDensity t) / log (log (t : ℝ)) ≤ transferRate lam q + eps) : atTop.liminf (fun t : ℕ ↦ -log (divisorDensity t) / log (log (t : ℝ))) = delta := by apply divisorDensity_liminf_eq_of_frequent_rates hscaled intro eps heps obtain ⟨lam, hlam, hlam2, q, hq, hrate⟩ := exists_transferRate_lt (half_pos heps) exact (htransfer lam hlam hlam2 q hq (eps / 2) (half_pos heps)).mono fun t ht ↦ by linarith /-- Finite Hölder transfer in exponential-rate form. -/ theorem holder_log_rate_le {q E S M H beta mu : ℝ} (hq : 1 < q) (hE : 0 < E) (hS : 0 < S) (hM : 0 < M) (hH : 0 < H) (hholder : S ≤ E ^ (1 - q⁻¹) * M ^ q⁻¹) (hlower : exp (-beta * H) ≤ S) (hmoment : log M ≤ mu * H) : -log E / H ≤ (q * beta + mu) / (q - 1) := by have hq0 : 0 < q := by linarith have hlogS := log_le_log (exp_pos _) hlower rw [log_exp] at hlogS have htransfer := log_lower_bound_of_holder hq hE hS hM hholder have htransfer' := (div_le_iff₀ (sub_pos.mpr hq)).mp htransfer have hmul := mul_le_mul_of_nonneg_left hlogS hq0.le apply (div_le_iff₀ hH).mpr rw [div_mul_eq_mul_div] apply (le_div_iff₀ (sub_pos.mpr hq)).mpr nlinarith end Erdos859Verification end /- Inlined development module: DivisorLowerConclusion.lean -/ section /- Only the frequent lower-density estimate remains in the logarithmic rate. -/ open Filter Real open scoped Topology namespace Erdos859Verification theorem divisorDensity_liminf_eq_of_arbitrarily_large_lower (hlower : ∀ eps : ℝ, 0 < eps → ∃ᶠ t : ℕ in atTop, exp (-(delta + eps) * log (log (t : ℝ))) ≤ divisorDensity t) : atTop.liminf (fun t : ℕ ↦ -log (divisorDensity t) / log (log (t : ℝ))) = delta := divisorDensity_liminf_eq_of_frequent_lower divisorDensity_critical_scaled_tendsto_zero hlower theorem divisorDensity_liminf_eq_of_arbitrarily_large_transfer (htransfer : ∀ lam : ℝ, criticalTilt < lam → lam < 2 → ∀ q : ℝ, 1 < q → ∀ eps : ℝ, 0 < eps → ∃ᶠ t : ℕ in atTop, -log (divisorDensity t) / log (log (t : ℝ)) ≤ transferRate lam q + eps) : atTop.liminf (fun t : ℕ ↦ -log (divisorDensity t) / log (log (t : ℝ))) = delta := divisorDensity_liminf_eq_of_transfer_rates divisorDensity_critical_scaled_tendsto_zero htransfer end Erdos859Verification end /- Inlined development module: PrimeHarmonicAverage.lean -/ section /- Finite target averages of actual representation indicators, their exact tilt transfer, and extraction of one target with a lower density bound. -/ open Finset Real Filter open scoped Topology Classical namespace Erdos859Verification noncomputable def finiteTargetDensityAverage (S : Finset ℕ) (w : ℕ → ℝ) : ℝ := (∑ t ∈ S, w t * divisorDensity t) / ∑ t ∈ S, w t noncomputable def primeTargetAverageObservable (S : Finset ℕ) (w : ℕ → ℝ) (T : Finset ℕ) : ℝ := (∑ t ∈ S, w t * (if (∏ p ∈ T, p) ∈ Erdos859.DivisorSumSet t then 1 else 0)) / ∑ t ∈ S, w t theorem finiteTargetDensityAverage_pos {S : Finset ℕ} (hS : S.Nonempty) {w : ℕ → ℝ} (hw : ∀ t ∈ S, 0 < w t) : 0 < finiteTargetDensityAverage S w := div_pos (sum_pos (fun t ht ↦ mul_pos (hw t ht) (divisorDensity_pos t)) hS) (sum_pos hw hS) theorem primeTargetAverageObservable_nonneg {S : Finset ℕ} {w : ℕ → ℝ} (hw : ∀ t ∈ S, 0 ≤ w t) (T : Finset ℕ) : 0 ≤ primeTargetAverageObservable S w T := by unfold primeTargetAverageObservable apply div_nonneg _ (sum_nonneg hw) exact sum_nonneg fun t ht ↦ mul_nonneg (hw t ht) (by split_ifs <;> norm_num) theorem primeTargetAverageObservable_le_one {S : Finset ℕ} (hS : S.Nonempty) {w : ℕ → ℝ} (hw : ∀ t ∈ S, 0 < w t) (T : Finset ℕ) : primeTargetAverageObservable S w T ≤ 1 := by unfold primeTargetAverageObservable apply (div_le_one (sum_pos hw hS)).mpr exact sum_le_sum fun t ht ↦ by split_ifs <;> simp [le_of_lt (hw t ht)] theorem primeTargetAverageObservable_eq_filtered_sum (S : Finset ℕ) (w : ℕ → ℝ) (T : Finset ℕ) : primeTargetAverageObservable S w T = (∑ t ∈ S.filter (fun t ↦ (∏ p ∈ T, p) ∈ Erdos859.DivisorSumSet t), w t) / ∑ t ∈ S, w t := by simp only [primeTargetAverageObservable, sum_filter, mul_ite, mul_one, mul_zero] theorem primeTargetAverageObservable_pattern_expectation_le {P S : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hS : S.Nonempty) {w : ℕ → ℝ} (hw : ∀ t ∈ S, 0 < w t) : (∑ T ∈ P.powerset, primePatternWeight P T * primeTargetAverageObservable S w T) ≤ finiteTargetDensityAverage S w := by let F : ℕ → Finset ℕ → ℝ := fun t T ↦ if (∏ p ∈ T, p) ∈ Erdos859.DivisorSumSet t then 1 else 0 have htarget (t : ℕ) : (∑ T ∈ P.powerset, primePatternWeight P T * F t T) ≤ divisorDensity t := by apply prime_observable_le_divisorDensity hP t (F t) · intro T dsimp [F] split_ifs <;> norm_num · intro T _ hT by_contra hnot simp [F, hnot] at hT have heq : (∑ T ∈ P.powerset, primePatternWeight P T * primeTargetAverageObservable S w T) = (∑ t ∈ S, w t * ∑ T ∈ P.powerset, primePatternWeight P T * F t T) / ∑ t ∈ S, w t := by simp only [primeTargetAverageObservable, ← mul_div_assoc, ← sum_div] congr 1 simp only [mul_sum] rw [sum_comm] apply sum_congr rfl intro t _ apply sum_congr rfl intro T _ dsimp [F] ring rw [heq] exact div_le_div_of_nonneg_right (sum_le_sum fun t ht ↦ mul_le_mul_of_nonneg_left (htarget t) (hw t ht).le) (sum_pos hw hS).le /-- The actual average of represented targets is a single observable in `[0,1]`, so only one likelihood moment is paid. -/ theorem primeTargetAverageObservable_holder {P S : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hS : S.Nonempty) {w : ℕ → ℝ} (hw : ∀ t ∈ S, 0 < w t) {lam q : ℝ} (hlam : 0 < lam) (hq : 1 ≤ q) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * primeTargetAverageObservable S w T) ≤ finiteTargetDensityAverage S w ^ (1 - q⁻¹) * (primeTiltNormalizer P (lam ^ q) / primeTiltNormalizer P lam ^ q) ^ q⁻¹ := by have h := holder_tilt_bound P.powerset hq (primePatternWeight P) (primeTargetAverageObservable S w) (primeTiltLikelihood P lam) (fun T ↦ (primePatternWeight_pos hP T).le) (primeTargetAverageObservable_nonneg (fun t ht ↦ (hw t ht).le)) (primeTargetAverageObservable_le_one hS hw) (fun T ↦ div_nonneg (pow_nonneg hlam.le _) (primeTiltNormalizer_pos hP hlam).le) have heq (T : Finset ℕ) : primePatternWeight P T * primeTargetAverageObservable S w T * primeTiltLikelihood P lam T = primeTiltWeight P lam T * primeTargetAverageObservable S w T := by unfold primeTiltLikelihood primeTiltWeight ring simp_rw [heq] at h rw [primeTiltLikelihood_moment hP hlam] at h apply h.trans apply mul_le_mul_of_nonneg_right _ (rpow_nonneg (div_pos (primeTiltNormalizer_pos hP (rpow_pos_of_pos hlam q)) (rpow_pos_of_pos (primeTiltNormalizer_pos hP hlam) q)).le _) apply rpow_le_rpow · exact sum_nonneg fun T _ ↦ mul_nonneg (primePatternWeight_pos hP T).le (primeTargetAverageObservable_nonneg (fun t ht ↦ (hw t ht).le) T) · exact primeTargetAverageObservable_pattern_expectation_le hP hS hw · have hinv : q⁻¹ ≤ (1 : ℝ) := by simpa using one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 1) hq linarith theorem primeTargetAverageObservable_tilt_lower_of_event {P S : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {w : ℕ → ℝ} (hw : ∀ t ∈ S, 0 ≤ w t) {lam c : ℝ} (hlam : 0 < lam) (Good : Finset ℕ → Prop) (hgood : ∀ T ∈ P.powerset, Good T → c ≤ primeTargetAverageObservable S w T) : c * (∑ T ∈ P.powerset.filter Good, primeTiltWeight P lam T) ≤ ∑ T ∈ P.powerset, primeTiltWeight P lam T * primeTargetAverageObservable S w T := by rw [sum_filter, mul_sum] apply sum_le_sum intro T hT by_cases hg : Good T · rw [if_pos hg] simpa only [mul_comm c] using mul_le_mul_of_nonneg_left (hgood T hT hg) (primeTiltWeight_pos hP hlam T).le · rw [if_neg hg, mul_zero] exact mul_nonneg (primeTiltWeight_pos hP hlam T).le (primeTargetAverageObservable_nonneg hw T) /-- A quantitative tilted harmonic-coverage bound and its exact moment produce an actual represented-target density at the desired logarithmic rate. -/ theorem primeTargetAverageObservable_exists_density_rate {P S : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hS : S.Nonempty) {w : ℕ → ℝ} (hw : ∀ t ∈ S, 0 < w t) {lam q H beta mu : ℝ} (hlam : 0 < lam) (hq : 1 < q) (hH : 0 < H) (hlower : exp (-beta * H) ≤ ∑ T ∈ P.powerset, primeTiltWeight P lam T * primeTargetAverageObservable S w T) (hmoment : log (primeTiltNormalizer P (lam ^ q) / primeTiltNormalizer P lam ^ q) ≤ mu * H) : ∃ t ∈ S, -log (divisorDensity t) / H ≤ (q * beta + mu) / (q - 1) := by have hE := finiteTargetDensityAverage_pos hS hw have hM : 0 < primeTiltNormalizer P (lam ^ q) / primeTiltNormalizer P lam ^ q := div_pos (primeTiltNormalizer_pos hP (rpow_pos_of_pos hlam q)) (rpow_pos_of_pos (primeTiltNormalizer_pos hP hlam) q) have hrate := holder_log_rate_le hq hE ((exp_pos _).trans_le hlower) hM hH (primeTargetAverageObservable_holder hP hS hw hlam hq.le) hlower hmoment obtain ⟨t, ht, htd⟩ := finite_positive_weight_average_exists S hS w divisorDensity hw (show finiteTargetDensityAverage S w * (∑ t ∈ S, w t) ≤ ∑ t ∈ S, w t * divisorDensity t from by rw [finiteTargetDensityAverage, div_mul_cancel₀ _ (sum_pos hw hS).ne']) refine ⟨t, ht, le_trans ?_ hrate⟩ exact div_le_div_of_nonneg_right (neg_le_neg (log_le_log hE htd)) hH.le theorem primeTargetAverageObservable_exists_target_rate {P S : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hS : S.Nonempty) {w : ℕ → ℝ} (hw : ∀ t ∈ S, 0 < w t) {lam q H beta mu : ℝ} (hlam : 0 < lam) (hq : 1 < q) (hH : 0 < H) (hscale : ∀ t ∈ S, H ≤ log (log (t : ℝ))) (hlower : exp (-beta * H) ≤ ∑ T ∈ P.powerset, primeTiltWeight P lam T * primeTargetAverageObservable S w T) (hmoment : log (primeTiltNormalizer P (lam ^ q) / primeTiltNormalizer P lam ^ q) ≤ mu * H) : ∃ t ∈ S, -log (divisorDensity t) / log (log (t : ℝ)) ≤ (q * beta + mu) / (q - 1) := by obtain ⟨t, ht, hrate⟩ := primeTargetAverageObservable_exists_density_rate hP hS hw hlam hq hH hlower hmoment refine ⟨t, ht, le_trans ?_ hrate⟩ exact div_le_div_of_nonneg_left (neg_nonneg.mpr (log_nonpos (divisorDensity_pos t).le (divisorDensity_le_one t))) hH (hscale t ht) end Erdos859Verification end /- Inlined development module: LogHorizonHarmonic.lean -/ section /- Explicit normalization bounds for a finite logarithmic target horizon. -/ open Finset Real open scoped Classical namespace Erdos859Verification theorem finite_log_horizon_harmonic_le (H : Finset ℕ) {B : ℝ} (hB : 0 ≤ B) (hpos : ∀ t ∈ H, 0 < t) (hlog : ∀ t ∈ H, log (t : ℝ) ≤ B) : (∑ t ∈ H, 1 / (t : ℝ)) ≤ 1 + B := by have hsub : H ⊆ Icc 1 ⌊exp B⌋₊ := by intro t ht have htR : (0 : ℝ) < t := by exact_mod_cast hpos t ht exact mem_Icc.mpr ⟨hpos t ht, (Nat.le_floor_iff (exp_pos B).le).mpr ((log_le_iff_le_exp htR).mp (hlog t ht))⟩ calc _ ≤ ∑ t ∈ Icc 1 ⌊exp B⌋₊, 1 / (t : ℝ) := sum_le_sum_of_subset_of_nonneg hsub (fun _ _ _ ↦ by positivity) _ = (harmonic ⌊exp B⌋₊ : ℝ) := by simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast, one_div] _ ≤ 1 + log (exp B) := harmonic_floor_le_one_add_log _ (one_le_exp_iff.mpr hB) _ = 1 + B := by rw [log_exp] theorem half_le_nat_floor_of_two_le {x : ℝ} (hx : 2 ≤ x) : x / 2 ≤ (⌊x⌋₊ : ℝ) := by have hfloor := Nat.lt_floor_add_one x have htwo : 2 ≤ ⌊x⌋₊ := (Nat.le_floor_iff (by linarith : 0 ≤ x)).mpr hx have htwoR : (2 : ℝ) ≤ ⌊x⌋₊ := by exact_mod_cast htwo linarith theorem logMesh_represented_harmonic_lower {R : Finset ℕ} {a b g : ℝ} {Z : ℕ} (hg : 0 ≤ g) (hlength : 2 * (g + log 4) ≤ b - a) (hpos : ∀ r ∈ R, 0 < r) (hmesh : ∀ x : ℝ, a ≤ x → x + g ≤ b → ∃ r ∈ R, x ≤ log (r : ℝ) ∧ log (r : ℝ) ≤ x + g) (hsize : ∀ r ∈ R, 4 ≤ Z * r) (H : Finset ℕ) (E : ℕ → Prop) (hH : ∀ r ∈ R, quarterTargetInterval (Z * r) ⊆ H) (hE : ∀ r ∈ R, ∀ t ∈ quarterTargetInterval (Z * r), E t) : (b - a) / (8 * (g + log 4)) ≤ ∑ t ∈ H.filter E, 1 / (t : ℝ) := by have hstep : 0 < g + log 4 := add_pos_of_nonneg_of_pos hg (log_pos (by norm_num)) have hx : 2 ≤ (b - a) / (g + log 4) := (le_div_iff₀ hstep).mpr hlength have hfloor := Nat.floor_le (show 0 ≤ (b - a) / (g + log 4) by linarith) have hbudget : ((⌊(b - a) / (g + log 4)⌋₊ : ℕ) : ℝ) * (g + log 4) ≤ b - a := (le_div_iff₀ hstep).mp hfloor have hmass := logMesh_represented_harmonic_mass hg hbudget hpos hmesh hsize H E hH hE have hhalf := half_le_nat_floor_of_two_le hx apply le_trans _ hmass calc _ = ((b - a) / (g + log 4) / 2) / 4 := by rw [div_div, div_div] congr 1 ring _ ≤ _ := div_le_div_of_nonneg_right hhalf (by norm_num) theorem logMesh_normalized_harmonic_lower {R H : Finset ℕ} {a b g B : ℝ} {Z : ℕ} (hg : 0 ≤ g) (hlength : 2 * (g + log 4) ≤ b - a) (hpos : ∀ r ∈ R, 0 < r) (hmesh : ∀ x : ℝ, a ≤ x → x + g ≤ b → ∃ r ∈ R, x ≤ log (r : ℝ) ∧ log (r : ℝ) ≤ x + g) (hsize : ∀ r ∈ R, 4 ≤ Z * r) (E : ℕ → Prop) (hH : ∀ r ∈ R, quarterTargetInterval (Z * r) ⊆ H) (hE : ∀ r ∈ R, ∀ t ∈ quarterTargetInterval (Z * r), E t) (hB : 0 ≤ B) (hHpos : ∀ t ∈ H, 0 < t) (hHlog : ∀ t ∈ H, log (t : ℝ) ≤ B) : (b - a) / (8 * (g + log 4) * (1 + B)) ≤ (∑ t ∈ H.filter E, 1 / (t : ℝ)) / (∑ t ∈ H, 1 / (t : ℝ)) := by have hstep : 0 < g + log 4 := add_pos_of_nonneg_of_pos hg (log_pos (by norm_num)) have hlength0 : 0 < b - a := (mul_pos (by norm_num) hstep).trans_le hlength have hlower := logMesh_represented_harmonic_lower hg hlength hpos hmesh hsize H E hH hE have hnum : 0 < ∑ t ∈ H.filter E, 1 / (t : ℝ) := (div_pos hlength0 (mul_pos (by norm_num) hstep)).trans_le hlower have hsub : (∑ t ∈ H.filter E, 1 / (t : ℝ)) ≤ ∑ t ∈ H, 1 / (t : ℝ) := sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun _ _ _ ↦ by positivity) have hden : 0 < ∑ t ∈ H, 1 / (t : ℝ) := hnum.trans_le hsub have hupper := finite_log_horizon_harmonic_le H hB hHpos hHlog calc _ = ((b - a) / (8 * (g + log 4))) / (1 + B) := by rw [div_div] _ ≤ (∑ t ∈ H.filter E, 1 / (t : ℝ)) / (1 + B) := div_le_div_of_nonneg_right hlower (by linarith) _ ≤ _ := div_le_div_of_nonneg_left hnum.le hden hupper end Erdos859Verification end /- Inlined development module: DivisorLogMeshPhase.lean -/ section /- Small uncovered logarithmic measure supplies actual divisors and a no-wrap phase gap. -/ open Finset Real MeasureTheory open scoped Classical namespace Erdos859Verification theorem finiteIntervalSupport_mesh_of_small_holes {ι : Type*} [Fintype ι] (atom : ι → ℝ) {a b d h x : ℝ} (hh : 0 < h) (hholes : volume.real (Set.Icc a b \ finiteIntervalSupport atom d) < h) (hxa : a+h≤x) (hxb : x≤b) : ∃ i, x-(d+h)≤atom i ∧ atom i≤x := by by_contra! hnone have hsub : Set.Icc (x-h) x ⊆ Set.Icc a b \ finiteIntervalSupport atom d := by intro z hz refine ⟨⟨by linarith [hz.1], hz.2.trans hxb⟩, ?_⟩ intro hs obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hs have hlo : x-(d+h)≤atom i := by linarith [hi.2, hz.1] have hhi : atom i≤x := hi.1.trans hz.2 exact (not_lt_of_ge hhi) (hnone i hlo) have hm := measureReal_mono (μ := volume) hsub (measure_ne_top_of_subset Set.sdiff_subset (isCompact_Icc : IsCompact (Set.Icc a b)).measure_ne_top) rw [volume_real_Icc_of_le (by linarith : x-h≤x)] at hm linarith theorem divisorLogSupport_mesh_of_small_holes {n : ℕ} {a b d h x : ℝ} (hh : 0 intro hq hqb have hqR : (0:ℝ) norm_num have h := primeTilt_positive_association hP hlam (fun T ↦ if F T then (1 : ℝ) else 0) (fun T ↦ if G T then (1 : ℝ) else 0) (fun _ ↦ by split_ifs <;> norm_num) (fun _ ↦ by split_ifs <;> norm_num) (hmono F hF) (hmono G hG) simpa only [sum_filter, mul_ite, mul_one, mul_zero, ← ite_and, and_comm] using h def CoreSupportCountEvent (eta : ℝ) (s : ℕ) (d threshold horizon countCap : ℝ) (T : Finset ℕ) : Prop := CoreRateWitness eta s T ∧ threshold ≤ volume.real (primeSubsetSumSupport T d ∩ Set.Icc 0 horizon) ∧ (T.card : ℝ) ≤ countCap /-- This is an actual finite FKG and Chernoff estimate. The core event itself is not treated as increasing; only the existence of a proper subcore is. -/ theorem core_support_count_mass_lower {P : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) {eta lam d threshold horizon countCap : ℝ} {s : ℕ} (hlam : 0 < lam) (hcore : coreRatePrimeUniverse s ⊆ P) (hsupport : (1 : ℝ) / 2 ≤ ∑ T ∈ P.powerset.filter (fun T ↦ threshold ≤ volume.real (primeSubsetSumSupport T d ∩ Set.Icc 0 horizon)), primeTiltWeight P lam T) : coreRateProperCoreMass eta lam s / 2 - exp ((exp 1 - 1) * (∑ p ∈ P, primeTiltSelectionProbability lam p) - countCap) ≤ ∑ T ∈ P.powerset.filter (CoreSupportCountEvent eta s d threshold horizon countCap), primeTiltWeight P lam T := by let Support : Finset ℕ → Prop := fun T ↦ threshold ≤ volume.real (primeSubsetSumSupport T d ∩ Set.Icc 0 horizon) let Good : Finset ℕ → Prop := fun T ↦ CoreRateWitness eta s T ∧ Support T let Bad : Finset ℕ → Prop := fun T ↦ countCap < (T.card : ℝ) have hcoremass := coreRateProperCoreMass_le_witness_mass hP hlam hcore (eta := eta) have hmass0 : 0 ≤ coreRateProperCoreMass eta lam s := sum_nonneg fun T _ ↦ (primeTiltWeight_pos (coreRatePrimeUniverse_allprime s) hlam T).le have hsupport0 : 0 ≤ ∑ T ∈ P.powerset.filter Support, primeTiltWeight P lam T := sum_nonneg fun T _ ↦ (primeTiltWeight_pos hP hlam T).le have hgood : coreRateProperCoreMass eta lam s / 2 ≤ ∑ T ∈ P.powerset.filter Good, primeTiltWeight P lam T := by have h := primeTilt_increasing_events_mass_mul_le hP hlam (CoreRateWitness eta s) Support (fun _ _ hST hS ↦ hS.mono hST) (fun _ _ hST hS ↦ hS.trans (primeSubsetSumSupport_inter_measure_mono d (Set.Icc 0 horizon) hST)) apply le_trans _ h simpa only [Support, div_eq_mul_inv, one_mul, mul_comm] using mul_le_mul hsupport hcoremass hmass0 hsupport0 have hbad : (∑ T ∈ P.powerset.filter Bad, primeTiltWeight P lam T) ≤ exp ((exp 1 - 1) * (∑ p ∈ P, primeTiltSelectionProbability lam p) - countCap) := by simpa only [one_mul] using primeTiltWeight_count_event_le hP hlam Bad 1 countCap (fun T _ hT ↦ by dsimp [Bad] at hT; linarith) have hsubtract := finite_good_event_subtract P.powerset (primeTiltWeight P lam) Good Bad (fun T _ ↦ (primeTiltWeight_pos hP hlam T).le) have hbound := (sub_le_sub hgood hbad).trans hsubtract have heq : P.powerset.filter (fun T ↦ Good T ∧ ¬ Bad T) = P.powerset.filter (CoreSupportCountEvent eta s d threshold horizon countCap) := by ext T simp only [mem_filter, Good, Support, Bad, CoreSupportCountEvent, not_lt, and_assoc] rw [heq] at hbound exact hbound end Erdos859Verification end /- Inlined development module: CoreBaseSupport.lean -/ section /- An actual base configuration simultaneously contains a proper core, has positive subset-log support, and uses at most eighteen primes per core rank. -/ open Finset Real Filter MeasureTheory open scoped Topology Classical namespace Erdos859Verification noncomputable def coreBaseEndpoint (k : ℕ) : ℝ := coreBallotShift k + coreBallotScale k * (2 : ℝ) ^ k noncomputable def coreBasePrimeUniverse (s : ℕ) : Finset ℕ := primeLogWindow (coreBallotShift (coreRateTotalLength s)) (coreBaseEndpoint (coreRateTotalLength s)) noncomputable def coreBaseThickness (k : ℕ) : ℝ := coreBallotShift k / 1000 theorem coreBallotShift_pos {k : ℕ} (hk : 0 < k) : 0 < coreBallotShift k := by unfold coreBallotShift positivity theorem coreBallotShift_ge_nat (k : ℕ) : (k : ℝ) ≤ coreBallotShift k := by by_cases hk : k = 0 · simp [hk, coreBallotShift] have hk1 : (1 : ℝ) ≤ k := by exact_mod_cast Nat.pos_of_ne_zero hk have hsq : (1 : ℝ) ≤ (k : ℝ) ^ 2 := one_le_pow₀ hk1 have hmul := mul_le_mul_of_nonneg_left hsq (Nat.cast_nonneg (α := ℝ) k) unfold coreBallotShift nlinarith theorem coreBallotShift_tendsto : Tendsto coreBallotShift atTop atTop := tendsto_atTop_mono coreBallotShift_ge_nat tendsto_natCast_atTop_atTop theorem coreBallotScale_le_shift {k : ℕ} (hk : 0 < k) : coreBallotScale k ≤ coreBallotShift k := by have hk1 : (1 : ℝ) ≤ k := by exact_mod_cast hk have hsq : (1 : ℝ) ≤ (k : ℝ) ^ 2 := one_le_pow₀ hk1 have hmul := mul_le_mul_of_nonneg_left hk1 (sq_nonneg (k : ℝ)) unfold coreBallotScale coreBallotShift nlinarith theorem coreBaseEndpoint_ge_shift (k : ℕ) : coreBallotShift k ≤ coreBaseEndpoint k := by unfold coreBaseEndpoint exact le_add_of_nonneg_right (mul_nonneg (coreBallotScale_pos k).le (by positivity)) theorem coreBaseEndpoint_le_dyadic {k : ℕ} (hk : 0 < k) : coreBaseEndpoint k ≤ coreBallotShift k * (2 : ℝ) ^ (k + 1) := by have hA := coreBallotShift_pos hk have hpow : (1 : ℝ) ≤ 2 ^ k := one_le_pow₀ (by norm_num) have h1 := mul_le_mul_of_nonneg_left hpow hA.le have h2 := mul_le_mul_of_nonneg_right (coreBallotScale_le_shift hk) (show (0 : ℝ) ≤ 2 ^ k by positivity) unfold coreBaseEndpoint rw [pow_succ] nlinarith theorem coreBaseEndpoint_eventually_twice_shift : ∀ᶠ k : ℕ in atTop, 2 * coreBallotShift k ≤ coreBaseEndpoint k := by filter_upwards [coreBallot_ratio_eventually_le_pow_head, eventually_gt_atTop 0] with k hratio hk have hhead : coreBallotHeadCount k ≤ k := by apply Nat.ceil_le.mpr exact sqrt_le_self_iff.mpr (Or.inr (by exact_mod_cast hk)) have hp : (2 : ℝ) ^ coreBallotHeadCount k ≤ 2 ^ k := pow_le_pow_right₀ (by norm_num) hhead have h := (div_le_iff₀ (coreBallotScale_pos k)).mp (hratio.trans hp) unfold coreBaseEndpoint nlinarith theorem coreBasePrimeUniverse_allprime (s : ℕ) : ∀ p ∈ coreBasePrimeUniverse s, p.Prime := fun _ hp ↦ (mem_primeLogWindow.mp hp).1 theorem coreRatePrimeUniverse_subset_base (s : ℕ) : coreRatePrimeUniverse s ⊆ coreBasePrimeUniverse s := by intro p hp change p ∈ virtualPrimeUniverse (coreBallotShift (coreRateTotalLength s)) (coreBallotScale (coreRateTotalLength s)) (coreRateTotalLength s) at hp rw [virtualPrimeUniverse_eq_window (coreBallotScale_pos _)] at hp obtain ⟨hp, hlo, hhi⟩ := mem_primeLogWindow.mp hp apply mem_primeLogWindow.mpr exact ⟨hp, (lt_add_of_pos_right _ (coreBallotScale_pos _)).trans hlo, hhi⟩ theorem coreBasePrime_mean_eventually_le_six {lam : ℝ} (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) : ∀ᶠ s : ℕ in atTop, (∑ p ∈ coreBasePrimeUniverse s, primeTiltSelectionProbability lam p) ≤ 6 * (coreRateTotalLength s : ℝ) := by have hAlarge := (coreBallotShift_tendsto.comp coreRateTotalLength_tendsto).eventually_ge_atTop (2 * mertensErrorConstant) filter_upwards [hAlarge] with s hlarge let k := coreRateTotalLength s let A := coreBallotShift k let X := coreBaseEndpoint k have hk : 0 < k := coreRateTotalLength_pos s have hk1 : (1 : ℝ) ≤ k := by exact_mod_cast hk have hA : 0 < A := coreBallotShift_pos hk have hAX : A ≤ X := coreBaseEndpoint_ge_shift k have hX : 0 < X := hA.trans_le hAX have hlog2 : log (2 : ℝ) ≤ 1 := by linarith [log_two_lt_d9] have hAlog : log 2 ≤ A := hlog2.trans (hk1.trans (coreBallotShift_ge_nat k)) have hratio : X / A ≤ (2 : ℝ) ^ (k + 1) := (div_le_iff₀ hA).mpr (by simpa only [mul_comm] using coreBaseEndpoint_le_dyadic hk) have hlogratio := log_le_log (div_pos hX hA) hratio rw [log_pow] at hlogratio have herr : 2 * mertensErrorConstant / A ≤ 1 := (div_le_one hA).mpr hlarge have hmass := (abs_le.mp (primeLogWindowMass_estimate hAlog hAX)).2 have hmass' : primeLogWindowMass A X ≤ ((k : ℝ) + 1) * log 2 + 1 := by push_cast at hlogratio linarith have hsum : (∑ p ∈ coreBasePrimeUniverse s, primeTiltSelectionProbability lam p) ≤ 2 * primeLogWindowMass A X := by rw [show primeLogWindowMass A X = ∑ p ∈ coreBasePrimeUniverse s, 1 / (p : ℝ) from rfl, mul_sum] apply sum_le_sum intro p hp have hp0 : (0 : ℝ) < p := by exact_mod_cast (coreBasePrimeUniverse_allprime s p hp).pos unfold primeTiltSelectionProbability calc _ ≤ lam / p := div_le_div_of_nonneg_left (by linarith) hp0 (by linarith) _ ≤ 2 / p := div_le_div_of_nonneg_right hlam2 hp0.le _ = _ := by ring have hlogprod := mul_le_mul_of_nonneg_left hlog2 (by positivity : 0 ≤ (k : ℝ) + 1) nlinarith theorem corePrefixRate_le_one_of_supercritical {lam : ℝ} (hcritical : 1 < lam * log 2) (hlam2 : lam ≤ 2) : corePrefixRate lam ≤ 1 := by have hlog : 0 < log (2 : ℝ) := log_pos (by norm_num) have hlam0 : 0 < lam := by nlinarith have hlog2 : log (2 : ℝ) ≤ 1 := by linarith [log_two_lt_d9] have hp := mul_le_mul_of_nonneg_left hlog2 hlam0.le have hnonneg : 0 ≤ log (lam * log 2) := log_nonneg hcritical.le unfold corePrefixRate linarith theorem coreBase_support_count_probability_lower {eta lam : ℝ} (heta : 0 < eta) (heta2 : eta ≤ log 2) (hcritical : 1 < lam * log 2) (hlam : 1 ≤ lam) (hlam2 : lam ≤ 2) : ∃ c : ℝ, 0 < c ∧ ∃ C : ℝ, 0 < C ∧ ∀ eps : ℝ, 0 < eps → ∀ᶠ s : ℕ in atTop, exp (-(corePrefixRate lam + eps) * (coreRateTotalLength s : ℝ)) ≤ ∑ T ∈ (coreBasePrimeUniverse s).powerset.filter (CoreSupportCountEvent eta s (coreBaseThickness (coreRateTotalLength s)) (c * coreBaseEndpoint (coreRateTotalLength s)) (C * coreBaseEndpoint (coreRateTotalLength s)) (18 * coreRateTotalLength s)), primeTiltWeight (coreBasePrimeUniverse s) lam T := by obtain ⟨c, hc, C, hC, A0, _hA0, hsupp⟩ := exists_primeWindow_positive_support_ambient hcritical (by norm_num : (0 : ℝ) < 1 / 1000) (by norm_num : (0 : ℝ) < 1 / 1000) refine ⟨c, hc, C, hC, ?_⟩ intro eps heps let e := min (eps / 2) (1 / 2 : ℝ) have he : 0 < e := lt_min (half_pos heps) (by norm_num) have hehalf : e ≤ eps / 2 := min_le_left _ _ have he1 : e ≤ 1 / 2 := min_le_right _ _ have hJ := corePrefixRate_le_one_of_supercritical hcritical hlam2 have hlam0 : 0 < lam := by linarith filter_upwards [coreRateProperCore_probability_lower heta heta2 hlam hlam2 he, coreBasePrime_mean_eventually_le_six hlam hlam2, (coreBallotShift_tendsto.comp coreRateTotalLength_tendsto).eventually_ge_atTop A0, coreRateTotalLength_tendsto.eventually coreBaseEndpoint_eventually_twice_shift, coreRateTotalLength_real_tendsto.eventually_ge_atTop (log 4), coreRateTotalLength_real_tendsto.eventually_ge_atTop (2 * log 4 / eps)] with s hcore hmean hA hX hklarge hkeps let k := coreRateTotalLength s have hk0 : (0 : ℝ) ≤ k := Nat.cast_nonneg _ have hsupport := hsupp (coreBallotShift k) hA (coreBaseEndpoint k) hX (coreBaseThickness k) (by simp only [coreBaseThickness]; ring_nf; rfl) (by simp only [coreBaseThickness]; ring_nf; rfl) (coreBasePrimeUniverse s) (coreBasePrimeUniverse_allprime s) Subset.rfl have hfinite := core_support_count_mass_lower (coreBasePrimeUniverse_allprime s) hlam0 (coreRatePrimeUniverse_subset_base s) hsupport (eta := eta) (countCap := 18 * k) have hexp : exp 1 - 1 ≤ (2 : ℝ) := by linarith [exp_one_lt_three] have hexp0 : 0 ≤ exp 1 - 1 := by linarith [exp_pos 1, exp_one_gt_two] have htail : exp ((exp 1 - 1) * (∑ p ∈ coreBasePrimeUniverse s, primeTiltSelectionProbability lam p) - 18 * k) ≤ (1 / 4 : ℝ) * exp (-(corePrefixRate lam + e) * k) := by have hmean' := mul_le_mul_of_nonneg_left hmean hexp0 have hconst := mul_le_mul_of_nonneg_right hexp (show (0 : ℝ) ≤ 6 * k by positivity) have hexponent : (exp 1 - 1) * (∑ p ∈ coreBasePrimeUniverse s, primeTiltSelectionProbability lam p) - 18 * k ≤ -log 4 - (corePrefixRate lam + e) * k := by have hrate := mul_le_mul_of_nonneg_right (show corePrefixRate lam + e ≤ 2 by linarith) hk0 dsimp [k] at hk0 ⊢ nlinarith calc _ ≤ exp (-log 4 - (corePrefixRate lam + e) * k) := exp_le_exp.mpr hexponent _ = _ := by rw [sub_eq_add_neg, exp_add, exp_neg, exp_log (by norm_num)]; norm_num; ring have htarget : exp (-(corePrefixRate lam + eps) * k) ≤ (1 / 4 : ℝ) * exp (-(corePrefixRate lam + e) * k) := by have hkineq := (div_le_iff₀ heps).mp hkeps have heineq := mul_le_mul_of_nonneg_right hehalf hk0 calc _ ≤ exp (-log 4 - (corePrefixRate lam + e) * k) := exp_le_exp.mpr (by dsimp [k] at *; nlinarith) _ = _ := by rw [sub_eq_add_neg, exp_add, exp_neg, exp_log (by norm_num)]; norm_num; ring dsimp [k] at htail htarget hfinite linarith end Erdos859Verification end /- Inlined development module: CorePairParameters.lean -/ section /- Explicit quadratic-refinement parameters on the core-rate subsequence. -/ open Filter Real open scoped Topology namespace Erdos859Verification def corePairDepth (s : ℕ) : ℕ := 8 * coreRateBlockLength s noncomputable def corePairScale (s : ℕ) : ℝ := coreBallotShift (coreRateTotalLength s) + coreBallotScale (coreRateTotalLength s) * (2:ℝ)^coreRateTotalLength s theorem corePairDepth_pos (s : ℕ) : 0 simp only [corePairDepth,Nat.cast_mul,Nat.cast_ofNat,mul_pow,mul_zero] ring theorem corePairDepth_shifted_square_div_total_tendsto (r₀ : ℕ) : Tendsto (fun s ↦ ((corePairDepth s+r₀+1:ℕ):ℝ)^2/coreRateTotalLength s) atTop (𝓝 0) := by have hlim := coreRate_squared_length_div_total_tendsto.const_mul (((r₀:ℝ)+9)^2) simp only [mul_zero] at hlim apply squeeze_zero (fun _ ↦ by positivity) (fun s ↦ ?_) hlim have hh : (1:ℝ)≤coreRateBlockLength s := by exact_mod_cast coreRateBlockLength_pos s have hraw : ((corePairDepth s+r₀+1:ℕ):ℝ)≤((r₀:ℝ)+9)*coreRateBlockLength s := by simp only [corePairDepth,Nat.cast_add,Nat.cast_mul,Nat.cast_ofNat,Nat.cast_one] nlinarith [Nat.cast_nonneg (α:=ℝ) r₀] have hsq := pow_le_pow_left₀ (by positivity : (0:ℝ)≤((corePairDepth s+r₀+1:ℕ):ℝ)) hraw 2 exact (div_le_div_of_nonneg_right hsq (Nat.cast_nonneg _)).trans_eq (by ring) theorem corePairDepth_log_cost_tendsto (C : ℝ) (r₀ : ℕ) : Tendsto (fun s ↦ log (exp (-C*((corePairDepth s+r₀+1:ℕ):ℝ)^2)) / coreRateTotalLength s) atTop (𝓝 0) := by simpa only [log_exp,mul_div_assoc,mul_zero] using (corePairDepth_shifted_square_div_total_tendsto r₀).const_mul (-C) theorem corePairDepth_cost_eventually_lower (C : ℝ) (r₀ : ℕ) {eps : ℝ} (heps : 0 first | rfl | ring theorem coreGlobalLogHorizon_tendsto : Tendsto (fun s ↦ coreGlobalLogHorizon (coreRateTotalLength s)) atTop atTop := by apply tendsto_atTop_mono (fun s ↦ ?_) coreRateTotalLength_real_tendsto exact (coreBallotShift_ge_nat _).trans ((coreBaseEndpoint_ge_shift _).trans (coreGlobalLogHorizon_ge_base s)) theorem coreGlobalLogHorizon_log_bounds (s : ℕ) : (coreRateTotalLength s : ℝ) * log 2 ≤ log (coreGlobalLogHorizon (coreRateTotalLength s)) ∧ log (coreGlobalLogHorizon (coreRateTotalLength s)) ≤ (coreRateTotalLength s : ℝ) * log 2 + log 15 + 6 * log (coreRateTotalLength s : ℝ) := by have hk : (0 : ℝ) < coreRateTotalLength s := by exact_mod_cast coreRateTotalLength_pos s have hH : 0 < coreGlobalLogHorizon (coreRateTotalLength s) := (by positivity : (0 : ℝ) < 2 ^ coreRateTotalLength s).trans_le (coreGlobalLogHorizon_ge_pow s) constructor · have h := log_le_log (by positivity : (0 : ℝ) < 2 ^ coreRateTotalLength s) (coreGlobalLogHorizon_ge_pow s) simpa only [log_pow] using h · have h := log_le_log hH (coreGlobalLogHorizon_upper s) rw [log_mul (by positivity) (by positivity), log_mul (by norm_num) (by positivity), log_pow, log_pow] at h norm_num only [Nat.cast_ofNat] at h linarith theorem coreGlobalLogHorizon_log_div_tendsto : Tendsto (fun s ↦ log (coreGlobalLogHorizon (coreRateTotalLength s)) / ((coreRateTotalLength s : ℝ) * log 2)) atTop (𝓝 1) := by have hlogk := (isLittleO_log_id_atTop.tendsto_div_nhds_zero.comp coreRateTotalLength_real_tendsto) have herror := (coreRateTotalLength_real_tendsto.const_div_atTop (log 15)).add (hlogk.const_mul 6) simp only [add_zero, mul_zero, Function.comp_def, id_eq] at herror have hzero : Tendsto (fun s ↦ log (coreGlobalLogHorizon (coreRateTotalLength s)) / (coreRateTotalLength s : ℝ) - log 2) atTop (𝓝 0) := by apply squeeze_zero (fun s ↦ ?_) (fun s ↦ ?_) herror · have hk : (0 : ℝ) < coreRateTotalLength s := by exact_mod_cast coreRateTotalLength_pos s have h : log 2 ≤ log (coreGlobalLogHorizon (coreRateTotalLength s)) / (coreRateTotalLength s : ℝ) := (le_div_iff₀ hk).mpr (by nlinarith [(coreGlobalLogHorizon_log_bounds s).1]) linarith · have hk : (0 : ℝ) < coreRateTotalLength s := by exact_mod_cast coreRateTotalLength_pos s have h := div_le_div_of_nonneg_right (coreGlobalLogHorizon_log_bounds s).2 hk.le rw [add_div, add_div, mul_div_cancel_left₀ _ hk.ne', mul_div_assoc] at h linarith have h := (tendsto_sub_nhds_zero_iff.mp hzero).div_const (log 2) simpa only [div_div, div_self (log_pos (by norm_num : (1 : ℝ) < 2)).ne'] using h theorem coreGlobalTargetHorizon_rate_scale {s t : ℕ} (ht : t ∈ coreGlobalTargetHorizon s) : (coreRateTotalLength s : ℝ) * log 2 ≤ log (log (t : ℝ)) := by have hlo := (mem_coreGlobalTargetHorizon.mp ht).2.1 have hX : (2 : ℝ) ^ coreRateTotalLength s ≤ log (t : ℝ) := (corePairScale_lower s).trans hlo have h := log_le_log (by positivity : (0 : ℝ) < 2 ^ coreRateTotalLength s) hX simpa only [log_pow] using h theorem coreGlobalTargetHorizon_escape (N : ℕ) : ∀ᶠ s : ℕ in atTop, ∀ t ∈ coreGlobalTargetHorizon s, N ≤ t := by filter_upwards [coreRateTotalLength_tendsto.eventually_ge_atTop N] with s hs intro t ht obtain ⟨ht0, hlo, _⟩ := mem_coreGlobalTargetHorizon.mp ht have hNt : (N : ℝ) ≤ log (t : ℝ) := (Nat.cast_le.mpr hs).trans ((coreBallotShift_ge_nat _).trans ((coreBaseEndpoint_ge_shift _).trans hlo)) have hlog := log_le_sub_one_of_pos (by exact_mod_cast ht0 : (0 : ℝ) < t) exact_mod_cast (show (N : ℝ) ≤ t by linarith) theorem coreGlobalTargetHorizon_eventually_nonempty : ∀ᶠ s : ℕ in atTop, (coreGlobalTargetHorizon s).Nonempty := by filter_upwards [coreRateTotalLength_tendsto.eventually_ge_atTop 2] with s hs let k := coreRateTotalLength s let X := coreBaseEndpoint k let t := ⌈exp X⌉₊ have hk : (2 : ℝ) ≤ k := by exact_mod_cast hs have hX1 : 1 ≤ X := (one_le_pow₀ (by norm_num : (1 : ℝ) ≤ 2)).trans (corePairScale_lower s) have hX : 0 < X := by linarith have ht0 : 0 < t := Nat.ceil_pos.mpr (exp_pos X) have htR : (0 : ℝ) < t := by exact_mod_cast ht0 have hlo : X ≤ log (t : ℝ) := by rw [le_log_iff_exp_le htR] exact Nat.le_ceil _ have hlog2 : log (2 : ℝ) ≤ 1 := by linarith [log_two_lt_d9] have hH : log 2 + X ≤ coreGlobalLogHorizon k := by have hk3 : 2 ≤ (k : ℝ) ^ 3 := by have h := pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 2) hk 3 norm_num at h linarith have hmul := mul_le_mul_of_nonneg_right hk3 hX.le unfold coreGlobalLogHorizon dsimp [X] at * linarith have hexpX : 1 ≤ exp X := one_le_exp_iff.mpr hX.le have htupper : (t : ℝ) ≤ exp (log 2 + X) := by rw [exp_add, exp_log (by norm_num)] have h := Nat.ceil_lt_add_one (exp_pos X).le dsimp [t] linarith exact ⟨t, mem_coreGlobalTargetHorizon.mpr ⟨ht0, hlo, (log_le_iff_le_exp htR).mpr (htupper.trans (exp_le_exp.mpr hH))⟩⟩ end Erdos859Verification end /- Inlined development module: CoreGlobalLikelihood.lean -/ section /- Exact likelihood cost for the complete global prime universe. -/ open Finset Real Filter open scoped Topology namespace Erdos859Verification theorem coreGlobalRateScale_pos (s : ℕ) : 0 < (coreRateTotalLength s : ℝ) * log 2 := mul_pos (by exact_mod_cast coreRateTotalLength_pos s) (log_pos (by norm_num)) theorem coreGlobalRateScale_tendsto : Tendsto (fun s ↦ (coreRateTotalLength s : ℝ) * log 2) atTop atTop := coreRateTotalLength_real_tendsto.atTop_mul_const (log_pos (by norm_num)) theorem coreGlobalPrime_reciprocal_div_tendsto : Tendsto (fun s ↦ (∑ p ∈ coreGlobalPrimeUniverse s, 1 / (p : ℝ)) / ((coreRateTotalLength s : ℝ) * log 2)) atTop (𝓝 1) := by have herror : Tendsto (fun s ↦ ((∑ p ∈ coreGlobalPrimeUniverse s, 1 / (p : ℝ)) - log (coreGlobalLogHorizon (coreRateTotalLength s)) - PrimeMertens.M) / ((coreRateTotalLength s : ℝ) * log 2)) atTop (𝓝 0) := by apply squeeze_zero_norm' _ (coreGlobalRateScale_tendsto.const_div_atTop mertensErrorConstant) filter_upwards [coreGlobalLogHorizon_tendsto.eventually_ge_atTop 1, coreGlobalLogHorizon_tendsto.eventually_ge_atTop (log 2)] with s hH hlog have hH0 : 0 < coreGlobalLogHorizon (coreRateTotalLength s) := by linarith have hexp : 2 ≤ exp (coreGlobalLogHorizon (coreRateTotalLength s)) := by rw [← exp_log (by norm_num : (0 : ℝ) < 2)] exact exp_le_exp.mpr hlog have h := primeReciprocalSum_estimate hexp simp only [log_exp] at h have herr : mertensErrorConstant / coreGlobalLogHorizon (coreRateTotalLength s) ≤ mertensErrorConstant := (div_le_iff₀ hH0).mpr (le_mul_of_one_le_right mertensErrorConstant_pos.le hH) rw [Real.norm_eq_abs, abs_div, abs_of_pos (coreGlobalRateScale_pos s)] exact div_le_div_of_nonneg_right (h.trans herr) (coreGlobalRateScale_pos s).le have h := (herror.add coreGlobalLogHorizon_log_div_tendsto).add (coreGlobalRateScale_tendsto.const_div_atTop PrimeMertens.M) simp only [zero_add, add_zero] at h apply h.congr intro s ring theorem log_tiltNormalizer_div_tendsto_of_reciprocal_scale (P : ℕ → Finset ℕ) (scale : ℕ → ℝ) (hscale : Tendsto scale atTop atTop) (hreciprocal : Tendsto (fun s ↦ (∑ p ∈ P s, 1 / (p : ℝ)) / scale s) atTop (𝓝 1)) {lam : ℝ} (hlam : 1 ≤ lam) : Tendsto (fun s ↦ log (primeTiltNormalizer (P s) lam) / scale s) atTop (𝓝 (lam - 1)) := by have herror : Tendsto (fun s ↦ (log (primeTiltNormalizer (P s) lam) - (lam - 1) * ∑ p ∈ P s, 1 / (p : ℝ)) / scale s) atTop (𝓝 0) := by apply squeeze_zero_norm' _ (hscale.const_div_atTop ((lam - 1) ^ 2 * reciprocalSquareBound)) filter_upwards [hscale.eventually_gt_atTop 0] with s hs rw [Real.norm_eq_abs, abs_div, abs_of_pos hs] exact div_le_div_of_nonneg_right (log_primeTiltNormalizer_error (P s) hlam) hs.le have h := herror.add (hreciprocal.const_mul (lam - 1)) simp only [mul_one, zero_add] at h apply h.congr intro s ring theorem coreGlobalPrime_log_normalizer_div_tendsto {lam : ℝ} (hlam : 1 ≤ lam) : Tendsto (fun s ↦ log (primeTiltNormalizer (coreGlobalPrimeUniverse s) lam) / ((coreRateTotalLength s : ℝ) * log 2)) atTop (𝓝 (lam - 1)) := log_tiltNormalizer_div_tendsto_of_reciprocal_scale coreGlobalPrimeUniverse _ coreGlobalRateScale_tendsto coreGlobalPrime_reciprocal_div_tendsto hlam noncomputable def coreGlobalLikelihoodMoment (lam q : ℝ) (s : ℕ) : ℝ := primeTiltNormalizer (coreGlobalPrimeUniverse s) (lam ^ q) / primeTiltNormalizer (coreGlobalPrimeUniverse s) lam ^ q theorem coreGlobalLikelihoodMoment_pos {lam : ℝ} (hlam : 0 < lam) (q : ℝ) (s : ℕ) : 0 < coreGlobalLikelihoodMoment lam q s := div_pos (primeTiltNormalizer_pos (coreGlobalPrimeUniverse_allprime s) (rpow_pos_of_pos hlam q)) (rpow_pos_of_pos (primeTiltNormalizer_pos (coreGlobalPrimeUniverse_allprime s) hlam) q) theorem coreGlobalLikelihoodMoment_eq_finite_moment {lam : ℝ} (hlam : 0 < lam) (q : ℝ) (s : ℕ) : coreGlobalLikelihoodMoment lam q s = ∑ T ∈ (coreGlobalPrimeUniverse s).powerset, primePatternWeight (coreGlobalPrimeUniverse s) T * primeTiltLikelihood (coreGlobalPrimeUniverse s) lam T ^ q := (primeTiltLikelihood_moment (coreGlobalPrimeUniverse_allprime s) hlam q).symm theorem coreGlobalLikelihoodMoment_log_div_tendsto {lam q : ℝ} (hlam : 1 ≤ lam) (hq : 0 ≤ q) : Tendsto (fun s ↦ log (coreGlobalLikelihoodMoment lam q s) / ((coreRateTotalLength s : ℝ) * log 2)) atTop (𝓝 (lam ^ q - 1 - q * (lam - 1))) := by have hlam0 : 0 < lam := zero_lt_one.trans_le hlam have h := (coreGlobalPrime_log_normalizer_div_tendsto (one_le_rpow hlam hq)).sub ((coreGlobalPrime_log_normalizer_div_tendsto hlam).const_mul q) apply h.congr intro s unfold coreGlobalLikelihoodMoment rw [log_div (primeTiltNormalizer_pos (coreGlobalPrimeUniverse_allprime s) (rpow_pos_of_pos hlam0 q)).ne' (rpow_pos_of_pos (primeTiltNormalizer_pos (coreGlobalPrimeUniverse_allprime s) hlam0) q).ne', log_rpow (primeTiltNormalizer_pos (coreGlobalPrimeUniverse_allprime s) hlam0)] ring theorem coreGlobalLikelihoodMoment_eventually_upper {lam q eps : ℝ} (hlam : 1 ≤ lam) (hq : 0 ≤ q) (heps : 0 < eps) : ∀ᶠ s : ℕ in atTop, log (coreGlobalLikelihoodMoment lam q s) ≤ (lam ^ q - 1 - q * (lam - 1) + eps) * ((coreRateTotalLength s : ℝ) * log 2) := by filter_upwards [(coreGlobalLikelihoodMoment_log_div_tendsto hlam hq).eventually_lt_const (lt_add_of_pos_right _ heps)] with s hs exact ((div_lt_iff₀ (coreGlobalRateScale_pos s)).mp hs).le end Erdos859Verification end /- Inlined development module: PrimePairWindowRegular.lean -/ section /- Finite width conditions and a uniform cost bound for actual prime-pair windows. -/ open Finset Real open scoped Classical namespace Erdos859Verification theorem primePair_duplicate_width_bound {u w : ℝ} (hu : 0 < u) (hw : 0 < w) : 64 * exp (-u) / (w / u) ≤ 64 / w := by have hexp : u ≤ exp u := by linarith [add_one_le_exp u] have hm : u * exp (-u) ≤ 1 := by rw [exp_neg, ← div_eq_mul_inv] exact (div_le_one (exp_pos u)).mpr hexp calc _ = (64 / w) * (u * exp (-u)) := by field_simp _ ≤ (64 / w) * 1 := mul_le_mul_of_nonneg_left hm (by positivity) _ = _ := mul_one _ theorem primePair_hole_window_conditions_of_widths {ell : ℝ} (u : ℕ → ℝ) (n : ℕ) (hregular : ∀ i < n, log 2 ≤ u i ∧ 0 < quadraticHoleWidth ell i ∧ quadraticHoleWidth ell i ≤ u i ∧ 8 * primeLogOddsErrorConstant ≤ quadraticHoleWidth ell i ∧ 256 ≤ quadraticHoleWidth ell i) : PrimePairHoleWindowConditions ell u (fun i ↦ quadraticHoleWidth ell i / u i) (fun _ ↦ 1 / 4) n := by intro i hi obtain ⟨hu, hw, hwu, hlarge, hwidth⟩ := hregular i hi have hu0 : 0 < u i := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hu have heq : quadraticHoleWidth ell i / u i * u i = quadraticHoleWidth ell i := div_mul_cancel₀ _ hu0.ne' refine ⟨hu, div_pos hw hu0, (div_le_one hu0).mpr hwu, ?_, by norm_num, ?_, heq⟩ · rwa [heq] · have hd := primePair_duplicate_width_bound hu0 hw have hsmall : 64 / quadraticHoleWidth ell i ≤ (1 : ℝ) / 4 := (div_le_iff₀ hw).mpr (by linarith) change (1 : ℝ) / 4 ≤ 1 / 2 - 64 * exp (-u i) / (quadraticHoleWidth ell i / u i) linarith theorem primePair_initial_window_conditions_of_width {L rho : ℝ} (u : ℕ → ℝ) (n : ℕ) (hrho : 0 < rho) (hL : 0 < L) (hlarge : 8 * primeLogOddsErrorConstant ≤ 2 * L) (hduplicate : 4096 ≤ rho * (2 * L)) (hregular : ∀ i < n, log 2 ≤ u i ∧ 2 * L ≤ u i) : PrimePairInitialWindowConditions L rho u (fun i ↦ 2 * L / u i) (fun _ ↦ rho / 64) n := by intro i hi obtain ⟨hu, hwu⟩ := hregular i hi have hu0 : 0 < u i := (log_pos (by norm_num : (1 : ℝ) < 2)).trans_le hu have hw : 0 < 2 * L := by positivity have heq : 2 * L / u i * u i = 2 * L := div_mul_cancel₀ _ hu0.ne' refine ⟨hu, div_pos hw hu0, (div_le_one hu0).mpr hwu, ?_, by positivity, ?_, heq⟩ · rwa [heq] · have hd := primePair_duplicate_width_bound hu0 hw have hsmall : 64 / (2 * L) ≤ rho / 64 := (div_le_iff₀ hw).mpr (by nlinarith) change rho / 64 ≤ rho / 32 - 64 * exp (-u i) / (2 * L / u i) linarith theorem primePairStepCost_lower {eps eta : ℝ} (_heps : 0 < eps) (heps1 : eps ≤ 1) (heta : 0 ≤ eta) : eta * exp (-5) / 32 * eps ^ 2 ≤ primePairStepCost eps eta := by have he : exp (-5) ≤ exp (-5 * eps) := exp_le_exp.mpr (by linarith) have hm := mul_le_mul_of_nonneg_left he (mul_nonneg heta (sq_nonneg eps)) unfold primePairStepCost nlinarith theorem primePair_cost_product_lower (eps : ℕ → ℝ) (n : ℕ) {eta alpha : ℝ} (heta : 0 < eta) (halpha : 0 < alpha) (heps : ∀ i < n, alpha ≤ eps i ∧ eps i ≤ 1) : (eta * exp (-5) / 32 * alpha ^ 2) ^ n ≤ ∏ i ∈ range n, primePairStepCost (eps i) eta := by calc _ = ∏ _i ∈ range n, eta * exp (-5) / 32 * alpha ^ 2 := by simp _ ≤ _ := by apply prod_le_prod · intro i _ positivity · intro i hi have hi' := heps i (mem_range.mp hi) apply le_trans _ (primePairStepCost_lower (halpha.trans_le hi'.1) hi'.2 heta.le) exact mul_le_mul_of_nonneg_left (pow_le_pow_left₀ halpha.le hi'.1 2) (by positivity) theorem primePair_cost_product_exp_lower (eps : ℕ → ℝ) (n : ℕ) {eta alpha : ℝ} (heta : 0 < eta) (halpha : 0 < alpha) (heps : ∀ i < n, alpha ≤ eps i ∧ eps i ≤ 1) : exp (-(n : ℝ) * (5 + log 32 - log eta - 2 * log alpha)) ≤ ∏ i ∈ range n, primePairStepCost (eps i) eta := by have hbase : 0 < eta * exp (-5) / 32 * alpha ^ 2 := by positivity have hlog : log (eta * exp (-5) / 32 * alpha ^ 2) = -(5 + log 32 - log eta - 2 * log alpha) := by rw [log_mul (div_pos (mul_pos heta (exp_pos _)) (by norm_num)).ne' (pow_pos halpha 2).ne', log_div (mul_pos heta (exp_pos _)).ne' (by norm_num : (32 : ℝ) ≠ 0), log_mul heta.ne' (exp_pos _).ne', log_exp, log_pow] ring have heq : exp (-(n : ℝ) * (5 + log 32 - log eta - 2 * log alpha)) = (eta * exp (-5) / 32 * alpha ^ 2) ^ n := by rw [← exp_log hbase, ← exp_nat_mul, hlog] congr 1 ring rw [heq] exact primePair_cost_product_lower eps n heta halpha heps end Erdos859Verification end /- Inlined development module: CorePairWindows.lean -/ section /- Concrete fresh, disjoint initial and quadratic prime-pair windows. -/ open Finset Filter Real open scoped Topology Classical namespace Erdos859Verification noncomputable def corePairSpacing (C : ℝ) : ℝ := 100*(C+1) noncomputable def corePairWindowStart (C : ℝ) (s i : ℕ) : ℝ := corePairSpacing C*((i:ℝ)+1)*corePairScale s noncomputable def corePairWindowWidth (C : ℝ) (r₀ s i : ℕ) : ℝ := if i rw [quadraticHoleTrim_zero]; norm_num | succ n ih => rw [quadraticHoleTrim_succ,ih,quadraticHoleWidth] rw [show n+1+3=n+4 by omega,show n+4=(n+3)+1 by omega,pow_succ] field_simp ring theorem quadraticHoleTrim_le_eighth {L : ℝ} (hL : 0≤L) (n : ℕ) : quadraticHoleTrim L n≤L/8 := by rw [quadraticHoleTrim_exact] exact sub_le_self _ (by positivity) theorem quadraticHoleInterval_contains_middle {L : ℝ} (hL : 0≤L) (n : ℕ) : Set.Icc (L/8) (7*L/8)⊆quadraticHoleInterval L 0 L n := by intro x hx have ht := quadraticHoleTrim_le_eighth hL n exact ⟨by linarith [hx.1],by linarith [hx.2]⟩ end Erdos859Verification end /- Inlined development module: PrimeAdaptiveWindow.lean -/ section /- Exact conditioning for a fresh prime window chosen from the observed past. -/ open Finset open scoped Classical namespace Erdos859Verification theorem prime_tilt_adaptive_window_expectation {P A : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hA : A ⊆ P) {lam : ℝ} (hlam : 0 < lam) (Q : Finset ℕ → Finset ℕ) (hQ : ∀ S ⊆ A, Q S ⊆ P \ A) (F : Finset ℕ → Finset ℕ → ℝ) : (∑ T ∈ P.powerset, primeTiltWeight P lam T * F (T ∩ A) (T ∩ Q (T ∩ A))) = ∑ S ∈ A.powerset, primeTiltWeight A lam S * ∑ U ∈ (Q S).powerset, primeTiltWeight (Q S) lam U * F S U := by have hinter (T : Finset ℕ) : T ∩ Q (T ∩ A) = (T \ A) ∩ Q (T ∩ A) := by ext p constructor · intro hp obtain ⟨hpT, hpQ⟩ := mem_inter.mp hp have hpA := (mem_sdiff.mp (hQ _ inter_subset_right hpQ)).2 exact mem_inter.mpr ⟨mem_sdiff.mpr ⟨hpT, hpA⟩, hpQ⟩ · intro hp obtain ⟨hpT, hpQ⟩ := mem_inter.mp hp exact mem_inter.mpr ⟨(mem_sdiff.mp hpT).1, hpQ⟩ calc _ = ∑ T ∈ P.powerset, primeTiltWeight A lam (T ∩ A) * primeTiltWeight (P \ A) lam (T \ A) * F (T ∩ A) ((T \ A) ∩ Q (T ∩ A)) := by apply sum_congr rfl intro T _ rw [primeTiltWeight_split_universe hA, hinter T] _ = ∑ S ∈ A.powerset, ∑ V ∈ (P \ A).powerset, primeTiltWeight A lam S * primeTiltWeight (P \ A) lam V * F S (V ∩ Q S) := sum_powerset_split_subset hA (fun S V ↦ primeTiltWeight A lam S * primeTiltWeight (P \ A) lam V * F S (V ∩ Q S)) _ = _ := by apply sum_congr rfl intro S hS rw [show (∑ V ∈ (P \ A).powerset, primeTiltWeight A lam S * primeTiltWeight (P \ A) lam V * F S (V ∩ Q S)) = primeTiltWeight A lam S * ∑ V ∈ (P \ A).powerset, primeTiltWeight (P \ A) lam V * F S (V ∩ Q S) by simp only [mul_sum, mul_assoc]] rw [prime_tilt_expectation_restrict (fun p hp ↦ hP p (mem_sdiff.mp hp).1) (hQ S (mem_powerset.mp hS)) hlam] /-- Choosing the next window after seeing the past costs no independence factor: its variables are fresh, and the exact conditional law is unchanged. -/ theorem prime_tilt_adaptive_window_event_lower {P A : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hA : A ⊆ P) {lam : ℝ} (hlam : 0 < lam) (Q : Finset ℕ → Finset ℕ) (hQ : ∀ S ⊆ A, Q S ⊆ P \ A) (Good : Finset ℕ → Prop) (Step : Finset ℕ → Finset ℕ → Prop) {c : ℝ} (hstep : ∀ S ⊆ A, Good S → c ≤ ∑ U ∈ (Q S).powerset.filter (Step S), primeTiltWeight (Q S) lam U) : c * (∑ S ∈ A.powerset.filter Good, primeTiltWeight A lam S) ≤ ∑ T ∈ P.powerset.filter (fun T ↦ Good (T ∩ A) ∧ Step (T ∩ A) (T ∩ Q (T ∩ A))), primeTiltWeight P lam T := by have heq := prime_tilt_adaptive_window_expectation hP hA hlam Q hQ (fun S U ↦ if Good S ∧ Step S U then 1 else 0) simp only [mul_ite, mul_one, mul_zero, ← sum_filter] at heq rw [heq, sum_filter, mul_sum] apply sum_le_sum intro S hS have hSsub := mem_powerset.mp hS by_cases hg : Good S · simp only [hg, true_and, if_true] simpa only [mul_comm] using mul_le_mul_of_nonneg_left (hstep S hSsub hg) (primeTiltWeight_pos (fun p hp ↦ hP p (hA hp)) hlam S).le · simp only [hg, false_and, filter_false, sum_empty, if_false, mul_zero, le_refl] theorem prime_tilt_adaptive_success_lower {P A : Finset ℕ} (hP : ∀ p ∈ P, p.Prime) (hA : A ⊆ P) {lam : ℝ} (hlam : 0 < lam) (Q : Finset ℕ → Finset ℕ) (hQ : ∀ S ⊆ A, Q S ⊆ P \ A) (Good : Finset ℕ → Prop) (Step : Finset ℕ → Finset ℕ → Prop) (Success : Finset ℕ → Prop) {c : ℝ} (hstep : ∀ S ⊆ A, Good S → c ≤ ∑ U ∈ (Q S).powerset.filter (Step S), primeTiltWeight (Q S) lam U) (himp : ∀ T ⊆ P, Good (T ∩ A) → Step (T ∩ A) (T ∩ Q (T ∩ A)) → Success T) : c * (∑ S ∈ A.powerset.filter Good, primeTiltWeight A lam S) ≤ ∑ T ∈ P.powerset.filter Success, primeTiltWeight P lam T := by apply (prime_tilt_adaptive_window_event_lower hP hA hlam Q hQ Good Step hstep).trans apply sum_le_sum_of_subset_of_nonneg · intro T hT obtain ⟨hT, hgood, hnext⟩ := mem_filter.mp hT exact mem_filter.mpr ⟨hT, himp T (mem_powerset.mp hT) hgood hnext⟩ · intro T _ _ exact (primeTiltWeight_pos hP hlam T).le end Erdos859Verification end /- Inlined development module: PrimePairCombined.lean -/ section /- Initial coverage and adaptive quadratic refinement in the actual prime law. -/ open Finset Real MeasureTheory open scoped Classical namespace Erdos859Verification theorem inter_primeBandUnion_component {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) (T : Finset ℕ) (i : ι) : (T ∩ primeBandUnion P) ∩ P i = T ∩ P i := by have hsub : P i ⊆ primeBandUnion P := by intro p hp exact mem_biUnion.mpr ⟨i, mem_univ i, hp⟩ rw [inter_assoc, inter_eq_right.mpr hsub] def PrimePairCombinedSuccess {n r : ℕ} (L rho e : ℝ) (B : Set ℝ) (P : Fin n → Finset ℕ) (Q : Fin r → Finset ℕ) (T : Finset ℕ) : Prop := ∃ A, PrimePairInitialPath L rho e B n (fun i ↦ T ∩ P i) A ∧ PrimePairHoleSuccess L e 0 L A r (fun j ↦ T ∩ Q j) theorem primeTilt_combined_pair_success_lower {n r : ℕ} (P : Fin n → Finset ℕ) (Q : Fin r → Finset ℕ) (hP : ∀ i p, p ∈ P i → p.Prime) (hQ : ∀ i p, p ∈ Q i → p.Prime) (hdis : Disjoint (primeBandUnion P) (primeBandUnion Q)) {lam L rho e : ℝ} (hlam : 0 < lam) {B : Set ℝ} (hB : IsCompact B) {cI cR : ℝ} (hcR : 0 ≤ cR) (hinit : cI ≤ ∑ S ∈ (primeBandUnion P).powerset.filter (fun S ↦ PrimePairInitialSuccess L rho e B n (fun i ↦ S ∩ P i)), primeTiltWeight (primeBandUnion P) lam S) (hrefine : ∀ A : Set ℝ, IsCompact A → cR ≤ ∑ U ∈ (primeBandUnion Q).powerset.filter (fun U ↦ PrimePairHoleSuccess L e 0 L A r (fun j ↦ U ∩ Q j)), primeTiltWeight (primeBandUnion Q) lam U) : cI * cR ≤ ∑ T ∈ (primeBandUnion P ∪ primeBandUnion Q).powerset.filter (PrimePairCombinedSuccess L rho e B P Q), primeTiltWeight (primeBandUnion P ∪ primeBandUnion Q) lam T := by let I := primeBandUnion P let J := primeBandUnion Q let W := I ∪ J have hIprime : ∀ p ∈ I, p.Prime := by intro p hp obtain ⟨i, _, hi⟩ := mem_biUnion.mp hp exact hP i p hi have hJprime : ∀ p ∈ J, p.Prime := by intro p hp obtain ⟨i, _, hi⟩ := mem_biUnion.mp hp exact hQ i p hi have hWprime : ∀ p ∈ W, p.Prime := by intro p hp rcases mem_union.mp hp with hp | hp · exact hIprime p hp · exact hJprime p hp let Good : Finset ℕ → Prop := fun S ↦ PrimePairInitialSuccess L rho e B n (fun i ↦ S ∩ P i) let Step : Finset ℕ → Finset ℕ → Prop := fun S U ↦ ∃ A, PrimePairInitialPath L rho e B n (fun i ↦ S ∩ P i) A ∧ PrimePairHoleSuccess L e 0 L A r (fun j ↦ U ∩ Q j) have hnext : ∀ S ⊆ I, Good S → cR ≤ ∑ U ∈ J.powerset.filter (Step S), primeTiltWeight J lam U := by intro S _ hgood obtain ⟨A, hA⟩ := hgood apply (hrefine A (hA.isCompact hB)).trans apply sum_le_sum_of_subset_of_nonneg · intro U hU obtain ⟨hU, hpath⟩ := mem_filter.mp hU exact mem_filter.mpr ⟨hU, A, hA, hpath⟩ · intro U _ _ exact (primeTiltWeight_pos hJprime hlam U).le have hsub : J ⊆ W \ I := by intro p hp exact mem_sdiff.mpr ⟨mem_union_right I hp, fun hpI ↦ disjoint_left.mp hdis hpI hp⟩ have hmain := prime_tilt_adaptive_success_lower hWprime (subset_union_left : I ⊆ W) hlam (fun _ ↦ J) (fun _ _ ↦ hsub) Good Step (PrimePairCombinedSuccess L rho e B P Q) hnext (fun T _ _ hstep ↦ by obtain ⟨A, hA, hR⟩ := hstep refine ⟨A, ?_, ?_⟩ · simpa only [I, inter_primeBandUnion_component] using hA · simpa only [J, inter_primeBandUnion_component] using hR) apply le_trans _ hmain simpa only [mul_comm cR] using mul_le_mul_of_nonneg_left hinit hcR end Erdos859Verification end /- Inlined development module: PrimePairSupportComposition.lean -/ section /- Compose successive prime-pair support constructions with their exact translations. -/ open Finset Real MeasureTheory open scoped Classical namespace Erdos859Verification theorem finiteThickenedTranslateSupport_translate_base {ι : Type*} {A B : Set ℝ} {v : ℝ} (hAB : realTranslateSet A v ⊆ B) (I : Finset ι) (x : ι → ℝ) (e : ℝ) : realTranslateSet (finiteThickenedTranslateSupport A I x e) v ⊆ finiteThickenedTranslateSupport B I x e := by intro z hz obtain ⟨J, hJ, a, ha, herr⟩ := mem_finiteThickenedTranslateSupport.mp hz apply mem_finiteThickenedTranslateSupport.mpr refine ⟨J, hJ, a + v, hAB ?_, ?_⟩ · change a + v - v ∈ A simpa only [add_sub_cancel_right] using ha · have heq : z - (a + v) - ∑ i ∈ J, x i = (z - v) - a - ∑ i ∈ J, x i := by ring rwa [heq] theorem selected_pair_support_after_translate {ι : Type*} [Fintype ι] {T : ι → Finset ℕ} {p q : ι → ℕ} {C : Finset ℕ} {A : Set ℝ} {v d e : ℝ} (hA : realTranslateSet A v ⊆ primeSubsetSumSupport C d) (hdis : Pairwise (fun i j ↦ Disjoint (T i) (T j))) (hp : ∀ i, p i ∈ T i) (hq : ∀ i, q i ∈ T i) (hcore : Disjoint C (primeBandUnion T)) : realTranslateSet (finiteThickenedTranslateSupport A univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ)) e) (v + (∑ i, log (q i : ℝ)) + e) ⊆ primeSubsetSumSupport (C ∪ primeBandUnion T) (d + 2 * e) := by have hlabels := primePairLabels_subset_bandUnion hp hq have hembed := (prime_pair_thickened_support_subset (pairCoordinateSeparated_of_disjoint_sets hdis hp hq) (hcore.mono Set.Subset.rfl hlabels) d e).trans (primeSubsetSumSupport_mono (union_subset_union Set.Subset.rfl hlabels) _) intro z hz apply hembed apply finiteThickenedTranslateSupport_translate_base hA univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ)) e change z - ((∑ i, log (q i : ℝ)) + e) - v ∈ finiteThickenedTranslateSupport A univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ)) e have heq : z - ((∑ i, log (q i : ℝ)) + e) - v = z - (v + (∑ i, log (q i : ℝ)) + e) := by ring rwa [heq] theorem selected_pair_path_support_after_translate {ι : Type*} [Fintype ι] {T : ι → Finset ℕ} {p q : ι → ℕ} {C : Finset ℕ} {A S : Set ℝ} {v d e : ℝ} (hA : realTranslateSet A v ⊆ primeSubsetSumSupport C d) (hS : S ⊆ finiteThickenedTranslateSupport A univ (fun i ↦ log (p i : ℝ) - log (q i : ℝ)) e) (hdis : Pairwise (fun i j ↦ Disjoint (T i) (T j))) (hp : ∀ i, p i ∈ T i) (hq : ∀ i, q i ∈ T i) (hcore : Disjoint C (primeBandUnion T)) : realTranslateSet S (v + (∑ i, log (q i : ℝ)) + e) ⊆ primeSubsetSumSupport (C ∪ primeBandUnion T) (d + 2 * e) := by intro z hz exact selected_pair_support_after_translate hA hdis hp hq hcore (hS hz) end Erdos859Verification end /- Inlined development module: PrimePairCombinedGeometry.lean -/ section /- Actual divisor-log support furnished by the two successful prime-pair stages. -/ open Finset Real MeasureTheory open scoped Classical namespace Erdos859Verification theorem primePair_two_paths_divisor_support {n r : ℕ} {L rho e d : ℝ} {B A S : Set ℝ} {C : Finset ℕ} {x : Fin n → Finset ℕ} {y : Fin r → Finset ℕ} (hI : PrimePairInitialPath L rho e B n x A) (hR : PrimePairHolePath L e 0 L A r y S) (hB : IsCompact B) (hBC : B ⊆ primeSubsetSumSupport C d) (hL : 0 < L) (hrho : rho ≤ 32) (he : 0 ≤ e) (hstart : (1 - rho / 32) ^ n ≤ 1 / (2 : ℝ) ^ 10) (hdisx : Pairwise (fun i j ↦ Disjoint (x i) (x j))) (hdisy : Pairwise (fun i j ↦ Disjoint (y i) (y j))) (hcross : Disjoint (primeBandUnion x) (primeBandUnion y)) (hcorex : Disjoint C (primeBandUnion x)) (hcorey : Disjoint C (primeBandUnion y)) (hprime : ∀ p ∈ (C ∪ primeBandUnion x) ∪ primeBandUnion y, p.Prime) : ∃ q₀ : Fin n → ℕ, ∃ q₁ : Fin r → ℕ, (∀ i, q₀ i ∈ x i) ∧ (∀ j, q₁ j ∈ y j) ∧ let V := ((∑ i, log (q₀ i : ℝ)) + e) + (∑ j, log (q₁ j : ℝ)) + (r : ℝ) * e volume.real (Set.Icc (quadraticHoleTrim L r + V) (L - quadraticHoleTrim L r + V) \ divisorLogSupport (∏ p ∈ (C ∪ primeBandUnion x) ∪ primeBandUnion y, p) (d + 2 * e + 2 * ((r : ℝ) * e))) ≤ L / (2 : ℝ) ^ quadraticHoleExponent r := by obtain ⟨g₀, hg₀, hAgeom⟩ := hI.geometry he choose p₀ hp₀ q₀ hq₀ heq₀ using hg₀ have hg₀eq : g₀ = fun i ↦ log (p₀ i : ℝ) - log (q₀ i : ℝ) := funext heq₀ rw [hg₀eq] at hAgeom obtain ⟨g₁, hg₁, hSgeom⟩ := hR.geometry choose p₁ hp₁ q₁ hq₁ heq₁ using hg₁ have hg₁eq : g₁ = fun j ↦ log (p₁ j : ℝ) - log (q₁ j : ℝ) := funext heq₁ rw [hg₁eq] at hSgeom have hzero : realTranslateSet B 0 ⊆ primeSubsetSumSupport C d := by intro z hz apply hBC simpa only [realTranslateSet, Set.mem_preimage, sub_zero] using hz have hfirst := selected_pair_path_support_after_translate hzero hAgeom hdisx hp₀ hq₀ hcorex simp only [zero_add] at hfirst have hcore : Disjoint (C ∪ primeBandUnion x) (primeBandUnion y) := disjoint_union_left.mpr ⟨hcorey, hcross⟩ have hsecond := selected_pair_path_support_after_translate hfirst hSgeom hdisy hp₁ hq₁ hcore have hdiv := hsecond.trans (primeSubsetSumSupport_subset_divisorLogSupport hprime _) have hcompact := hR.isCompact (hI.isCompact hB) have hinit : volume.real (Set.Icc 0 L \ A) ≤ L / (2 : ℝ) ^ 10 := by apply (hI.hole_bound hL.le hrho).trans simpa only [div_eq_mul_inv, one_mul, mul_comm] using mul_le_mul_of_nonneg_right hstart hL.le have hholes := hR.hole_bound hL hinit simp only [quadraticHoleInterval, zero_add] at hholes have hmeasure := translated_missing_measure_le (I := Set.Icc (quadraticHoleTrim L r) (L - quadraticHoleTrim L r)) hcompact.measurableSet measurableSet_Icc isCompact_Icc.measure_ne_top (((∑ i, log (q₀ i : ℝ)) + e) + (∑ j, log (q₁ j : ℝ)) + (r : ℝ) * e) hdiv rw [realTranslateSet_Icc] at hmeasure refine ⟨q₀, q₁, hq₀, hq₁, ?_⟩ simpa only [quadraticHoleInterval, zero_add] using hmeasure.trans hholes end Erdos859Verification end /- Inlined development module: PrimePairSelectedGeometry.lean -/ section /- The two successful stages refer to the actual selected set and product. -/ open Finset Real MeasureTheory open scoped Classical namespace Erdos859Verification theorem primeBandUnion_inter {ι : Type*} [Fintype ι] (P : ι → Finset ℕ) (T : Finset ℕ) : primeBandUnion (fun i ↦ T ∩ P i) = T ∩ primeBandUnion P := by ext p simp only [primeBandUnion, mem_biUnion, mem_univ, true_and, mem_inter] aesop theorem primePairCombined_selected_union {n r : ℕ} {P : Fin n → Finset ℕ} {Q : Fin r → Finset ℕ} {T : Finset ℕ} (hT : T ⊆ primeBandUnion P ∪ primeBandUnion Q) (C : Finset ℕ) : (C ∪ primeBandUnion (fun i ↦ T ∩ P i)) ∪ primeBandUnion (fun j ↦ T ∩ Q j) = C ∪ T := by rw [primeBandUnion_inter, primeBandUnion_inter, union_assoc, ← inter_union_distrib_left, inter_eq_left.mpr hT] theorem PrimePairCombinedSuccess.card {n r : ℕ} {L rho e : ℝ} {B : Set ℝ} {P : Fin n → Finset ℕ} {Q : Fin r → Finset ℕ} {T : Finset ℕ} (hs : PrimePairCombinedSuccess L rho e B P Q T) (hT : T ⊆ primeBandUnion P ∪ primeBandUnion Q) (hP : Pairwise (fun i j ↦ Disjoint (P i) (P j))) (hQ : Pairwise (fun i j ↦ Disjoint (Q i) (Q j))) (hPQ : Disjoint (primeBandUnion P) (primeBandUnion Q)) : T.card = 2 * (n + r) := by obtain ⟨A, hI, S, hR⟩ := hs have hsplit : T = (T ∩ primeBandUnion P) ∪ (T ∩ primeBandUnion Q) := by rw [← inter_union_distrib_left, inter_eq_left.mpr hT] have hPc : (T ∩ primeBandUnion P).card = 2 * n := by rw [card_primeBand_intersections P hP inter_subset_right] simp only [inter_primeBandUnion_component, hI.counts, sum_const, card_univ, Fintype.card_fin, smul_eq_mul] omega have hQc : (T ∩ primeBandUnion Q).card = 2 * r := by rw [card_primeBand_intersections Q hQ inter_subset_right] simp only [inter_primeBandUnion_component, hR.counts, sum_const, card_univ, Fintype.card_fin, smul_eq_mul] omega have hd : Disjoint (T ∩ primeBandUnion P) (T ∩ primeBandUnion Q) := hPQ.mono inter_subset_right inter_subset_right calc T.card = ((T ∩ primeBandUnion P) ∪ (T ∩ primeBandUnion Q)).card := congrArg Finset.card hsplit _ = (T ∩ primeBandUnion P).card + (T ∩ primeBandUnion Q).card := card_union_of_disjoint hd _ = 2 * (n + r) := by rw [hPc, hQc]; omega theorem PrimePairCombinedSuccess.divisor_support {n r : ℕ} {L rho e d : ℝ} {B : Set ℝ} {C T : Finset ℕ} {P : Fin n → Finset ℕ} {Q : Fin r → Finset ℕ} (hs : PrimePairCombinedSuccess L rho e B P Q T) (hT : T ⊆ primeBandUnion P ∪ primeBandUnion Q) (hB : IsCompact B) (hBC : B ⊆ primeSubsetSumSupport C d) (hL : 0 < L) (hrho : rho ≤ 32) (he : 0 ≤ e) (hstart : (1 - rho / 32) ^ n ≤ 1 / (2 : ℝ) ^ 10) (hP : Pairwise (fun i j ↦ Disjoint (P i) (P j))) (hQ : Pairwise (fun i j ↦ Disjoint (Q i) (Q j))) (hPQ : Disjoint (primeBandUnion P) (primeBandUnion Q)) (hcore : Disjoint C (primeBandUnion P ∪ primeBandUnion Q)) (hprime : ∀ p ∈ C ∪ T, p.Prime) : ∃ q₀ : Fin n → ℕ, ∃ q₁ : Fin r → ℕ, (∀ i, q₀ i ∈ T ∩ P i) ∧ (∀ j, q₁ j ∈ T ∩ Q j) ∧ let V := (∑ i, log (q₀ i : ℝ)) + (∑ j, log (q₁ j : ℝ)) + (r + 1 : ℝ) * e volume.real (Set.Icc (quadraticHoleTrim L r + V) (L - quadraticHoleTrim L r + V) \ divisorLogSupport (∏ p ∈ C ∪ T, p) (d + 2 * ((r + 1 : ℝ) * e))) ≤ L / (2 : ℝ) ^ quadraticHoleExponent r := by obtain ⟨A, hI, S, hR⟩ := hs have hx : Pairwise (fun i j ↦ Disjoint (T ∩ P i) (T ∩ P j)) := fun _ _ hij ↦ (hP hij).mono inter_subset_right inter_subset_right have hy : Pairwise (fun i j ↦ Disjoint (T ∩ Q i) (T ∩ Q j)) := fun _ _ hij ↦ (hQ hij).mono inter_subset_right inter_subset_right have hu := primePairCombined_selected_union hT C have hxy : Disjoint (primeBandUnion (fun i ↦ T ∩ P i)) (primeBandUnion (fun j ↦ T ∩ Q j)) := by rw [primeBandUnion_inter, primeBandUnion_inter] exact hPQ.mono inter_subset_right inter_subset_right have hcx : Disjoint C (primeBandUnion (fun i ↦ T ∩ P i)) := by rw [primeBandUnion_inter] exact (disjoint_union_right.mp hcore).1.mono_right inter_subset_right have hcy : Disjoint C (primeBandUnion (fun i ↦ T ∩ Q i)) := by rw [primeBandUnion_inter] exact (disjoint_union_right.mp hcore).2.mono_right inter_subset_right have hp : ∀ p ∈ (C ∪ primeBandUnion (fun i ↦ T ∩ P i)) ∪ primeBandUnion (fun j ↦ T ∩ Q j), p.Prime := by rwa [hu] obtain ⟨q₀, q₁, hq₀, hq₁, hh⟩ := primePair_two_paths_divisor_support hI hR hB hBC hL hrho he hstart hx hy hxy hcx hcy hp refine ⟨q₀, q₁, hq₀, hq₁, ?_⟩ dsimp only at hh ⊢ rw [hu] at hh convert hh using 1 ring end Erdos859Verification end /- Inlined development module: CorePairWindowCost.lean -/ section /- The entire concrete pair-window construction has zero exponential cost. -/ open Finset Filter Real open scoped Topology Classical namespace Erdos859Verification noncomputable def corePairWindowEta (rho : ℝ) (r₀ i : ℕ) : ℝ := if i simp | succ n ih => rw [Fin.sum_univ_castSucc] simp only [Fin.val_castSucc, Fin.val_last, ih, Nat.cast_add, Nat.cast_one] ring theorem corePairWindowStart_sum (C : ℝ) (s n : ℕ) : (∑ i : Fin n, corePairWindowStart C s i.val) = corePairSpacing C * ((n : ℝ) * ((n : ℝ) + 1) / 2) * corePairScale s := by simp only [corePairWindowStart, ← sum_mul, ← mul_sum, corePair_fin_sum_index] theorem corePairLogSum_bounds {C : ℝ} (hC : 0 < C) {r₀ s : ℕ} (q : Fin (r₀ + corePairDepth s) → ℕ) (hq : ∀ i, q i ∈ corePairWindow C r₀ s i.val) : corePairSpacing C * (((r₀ + corePairDepth s : ℕ) : ℝ) * (((r₀ + corePairDepth s : ℕ) : ℝ) + 1) / 2) * corePairScale s ≤ corePairLogSum r₀ s q ∧ corePairLogSum r₀ s q ≤ corePairSpacing C * ((((r₀ + corePairDepth s : ℕ) : ℝ) + 1) ^ 2) * corePairScale s := by constructor · rw [← corePairWindowStart_sum] exact sum_le_sum fun i _ ↦ (mem_primeLogWindow.mp (hq i)).2.1.le · have hsum : corePairLogSum r₀ s q ≤ ((r₀ + corePairDepth s : ℕ) : ℝ) * corePairWindowStart C s (r₀ + corePairDepth s) := by calc _ ≤ ∑ _i : Fin (r₀ + corePairDepth s), corePairWindowStart C s (r₀ + corePairDepth s) := by apply sum_le_sum intro i _ exact ((mem_primeLogWindow.mp (hq i)).2.2.trans_lt (corePairWindow_endpoint_order hC r₀ s i.isLt)).le _ = _ := by simp apply hsum.trans unfold corePairWindowStart have hn : (0 : ℝ) ≤ ((r₀ + corePairDepth s : ℕ) : ℝ) := Nat.cast_nonneg _ have hD := (corePairSpacing_pos hC).le have hX := (corePairScale_pos s).le nlinarith [mul_nonneg hD hX] theorem corePairLocation_after_windows {C : ℝ} (hC : 0 < C) {r₀ s : ℕ} (q : Fin (r₀ + corePairDepth s) → ℕ) (hq : ∀ i, q i ∈ corePairWindow C r₀ s i.val) : corePairWindowStart C s (r₀ + corePairDepth s) ≤ corePairLocation r₀ s q := by have hsum := (corePairLogSum_bounds hC q hq).1 have hN : (2 : ℝ) ≤ ((r₀ + corePairDepth s : ℕ) : ℝ) := by have hh := coreRateBlockLength_pos s have : 2 ≤ r₀ + corePairDepth s := by unfold corePairDepth; omega exact_mod_cast this have hD := (corePairSpacing_pos hC).le have hX := (corePairScale_pos s).le have herr : 0 ≤ ((corePairDepth s : ℝ) + 1) * (32 * primeLogOddsErrorConstant) := by positivity [primeLogOddsErrorConstant_pos] unfold corePairLocation corePairWindowStart nlinarith [mul_nonneg hD hX, mul_nonneg (show 0 ≤ (((r₀ + corePairDepth s : ℕ) : ℝ) - 2) * (((r₀ + corePairDepth s : ℕ) : ℝ) + 1) by positivity) (mul_nonneg hD hX)] theorem corePairScale_anchor_comparison (s : ℕ) : log (coreAnchorCubeSize s (coreRateTotalLength s)) ≤ 9 * corePairScale s ∧ corePairScale s ≤ 15 * log (coreAnchorCubeSize s (coreRateTotalLength s)) := by let k := coreRateTotalLength s have hk : (1 : ℝ) ≤ k := by exact_mod_cast coreRateTotalLength_pos s have hpow : (k : ℝ) ≤ (2 : ℝ) ^ k := by exact_mod_cast k.lt_two_pow_self.le have hBlo : (k : ℝ) ^ 2 ≤ coreBallotScale k := by unfold coreBallotScale; nlinarith have hBhi : coreBallotScale k ≤ 5 * (k : ℝ) ^ 2 := by unfold coreBallotScale; nlinarith have hlo := coreAnchorCubeSize_log_lower s k have hhi := coreAnchorCubeSize_log_upper (s := s) (t := k) have hXlo : (k : ℝ) ^ 2 * (2 : ℝ) ^ k ≤ corePairScale s := by have h := mul_le_mul_of_nonneg_right hBlo (by positivity : (0 : ℝ) ≤ 2 ^ k) change _ ≤ 10 * (k : ℝ) ^ 3 + coreBallotScale k * (2 : ℝ) ^ k nlinarith constructor · exact hhi.trans (by nlinarith) · have h := mul_le_mul_of_nonneg_right hBhi (by positivity : (0 : ℝ) ≤ 2 ^ k) have hA := mul_le_mul_of_nonneg_left hpow (show 0 ≤ 10 * (k : ℝ) ^ 2 by positivity) change 10 * (k : ℝ) ^ 3 + coreBallotScale k * (2 : ℝ) ^ k ≤ _ nlinarith theorem corePairLocation_upper {C : ℝ} (hC : 0 < C) {r₀ s : ℕ} (q : Fin (r₀ + corePairDepth s) → ℕ) (hq : ∀ i, q i ∈ corePairWindow C r₀ s i.val) : corePairHighEndpoint C r₀ s q + C * corePairScale s ≤ corePairLocationConstant C * ((((r₀ + corePairDepth s : ℕ) : ℝ) + 1) ^ 2) * corePairScale s := by have hsum := (corePairLogSum_bounds hC q hq).2 have hX : 1 ≤ corePairScale s := (one_le_pow₀ (by norm_num : (1 : ℝ) ≤ 2)).trans (corePairScale_lower s) have hN : (corePairDepth s : ℝ) + 1 ≤ (((r₀ + corePairDepth s : ℕ) : ℝ) + 1) ^ 2 := by push_cast nlinarith [Nat.cast_nonneg (α := ℝ) r₀, Nat.cast_nonneg (α := ℝ) (corePairDepth s)] have hN1 : 2 ≤ (((r₀ + corePairDepth s : ℕ) : ℝ) + 1) ^ 2 := by have hr : (1 : ℝ) ≤ corePairDepth s := by exact_mod_cast corePairDepth_pos s push_cast nlinarith [Nat.cast_nonneg (α := ℝ) r₀] have he : 0 ≤ 32 * primeLogOddsErrorConstant := by positivity [primeLogOddsErrorConstant_pos] have herr := mul_le_mul_of_nonneg_right hN he have herrX := mul_le_mul_of_nonneg_left hX (show 0 ≤ ((((r₀ + corePairDepth s : ℕ) : ℝ) + 1) ^ 2) * (32 * primeLogOddsErrorConstant) by positivity) have hCX := mul_le_mul_of_nonneg_right hN1 (mul_nonneg hC.le (corePairScale_pos s).le) unfold corePairHighEndpoint corePairLocation corePairLocationConstant nlinarith theorem corePairHighStart_lower {C : ℝ} (hC : 100 ≤ C) {r₀ s : ℕ} (q : Fin (r₀ + corePairDepth s) → ℕ) (hq : ∀ i, q i ∈ corePairWindow C r₀ s i.val) : 2 * log (coreAnchorCubeSize s (coreRateTotalLength s)) ≤ corePairHighStart C r₀ s q ∧ corePairWindowStart C s (r₀ + corePairDepth s) < corePairHighStart C r₀ s q := by have hC0 : 0 < C := by linarith have hV := corePairLocation_after_windows hC0 q hq have hV0 : 0 ≤ corePairLocation r₀ s q := (corePairWindowStart_pos hC0 s _).le.trans hV have hM := (corePairScale_anchor_comparison s).1 have hCX := mul_le_mul_of_nonneg_right hC (corePairScale_pos s).le have hX := corePairScale_pos s unfold corePairHighStart corePairHighEndpoint coreHighWindowWidth constructor <;> nlinarith theorem corePairLocationConstant_pos {C : ℝ} (hC : 0 < C) : 0 < corePairLocationConstant C := by unfold corePairLocationConstant positivity [corePairSpacing_pos hC, primeLogOddsErrorConstant_pos] theorem corePairLocation_eventually_below_linear {C : ℝ} (hC : 0 < C) (r₀ : ℕ) : ∀ᶠ s in atTop, ∀ q : Fin (r₀ + corePairDepth s) → ℕ, (∀ i, q i ∈ corePairWindow C r₀ s i.val) → corePairHighEndpoint C r₀ s q + C * corePairScale s ≤ (coreRateTotalLength s : ℝ) * corePairScale s := by have hlim := (corePairDepth_shifted_square_div_total_tendsto r₀).const_mul (corePairLocationConstant C) simp only [mul_zero] at hlim filter_upwards [hlim.eventually_lt_const (by norm_num : (0 : ℝ) < 1)] with s hs intro q hq have hk : (0 : ℝ) < coreRateTotalLength s := by exact_mod_cast coreRateTotalLength_pos s have hb : corePairLocationConstant C * ((((r₀ + corePairDepth s : ℕ) : ℝ) + 1) ^ 2) ≤ coreRateTotalLength s := by have h := (div_lt_iff₀ hk).mp (show corePairLocationConstant C * (((corePairDepth s + r₀ + 1 : ℕ) : ℝ) ^ 2) / coreRateTotalLength s < 1 by simpa only [mul_div_assoc] using hs) push_cast at h ⊢ nlinarith exact (corePairLocation_upper hC q hq).trans (mul_le_mul_of_nonneg_right hb (corePairScale_pos s).le) end Erdos859Verification end /- Inlined development module: DivisorArithmeticBudget.lean -/ section /- Divisor counts and coefficient costs for an actual finite prime selection. -/ open Finset Real Filter MeasureTheory open scoped Classical namespace Erdos859Verification theorem card_divisors_primeProduct {T : Finset ℕ} (hT : ∀ p ∈ T, p.Prime) : (∏ p ∈ T, p).divisors.card = 2 ^ T.card := by rw [← image_divisorCubeWeight hT, card_image_of_injective _ (divisorCubeWeight_injective hT), card_univ, card_divisorCubeCoordinate] theorem divisorCoinsBelow_sum_le (n r : ℕ) : ∑ q ∈ divisorCoinsBelow n r, q ≤ n.divisors.card * r := by calc _ ≤ ∑ _q ∈ divisorCoinsBelow n r, r := sum_le_sum (fun _ hq ↦ (mem_filter.mp hq).2.le) _ = (divisorCoinsBelow n r).card * r := by simp _ ≤ _ := Nat.mul_le_mul_right r (card_le_card (filter_subset _ _)) theorem primeProduct_coefficient_cost {T : Finset ℕ} (hT : ∀ p ∈ T, p.Prime) {r Z : ℕ} {Y : ℝ} (hcost : 4 * bernoulliResidueLength r Y * 2 ^ T.card ≤ Z) : bernoulliResidueLength r Y ≤ Z ∧ 4 * bernoulliResidueLength r Y * ∑ q ∈ divisorCoinsBelow (∏ p ∈ T, p) r, q ≤ Z * r := by have hpow : 1 ≤ 2 ^ T.card := Nat.one_le_pow _ _ (by omega) constructor · have hm := Nat.mul_le_mul_left (4 * bernoulliResidueLength r Y) hpow omega · calc _ ≤ 4 * bernoulliResidueLength r Y * ((∏ p ∈ T, p).divisors.card * r) := Nat.mul_le_mul_left _ (divisorCoinsBelow_sum_le _ _) _ = (4 * bernoulliResidueLength r Y * 2 ^ T.card) * r := by simp only [card_divisors_primeProduct hT, Nat.mul_assoc] _ ≤ Z * r := Nat.mul_le_mul_right r hcost theorem primeProduct_coefficient_cost_eventually_uniform {C : ℝ} (hC : 0 ≤ C) : ∀ᶠ k : ℕ in atTop, ∀ T : Finset ℕ, (∀ p ∈ T, p.Prime) → T.card ≤ 20 * k → ∀ r : ℕ, 0 < r → log (2 * (r : ℝ)) ≤ exp (C * k) → bernoulliResidueLength r (bernoulliPhaseScale k : ℝ) ≤ bernoulliSeedScale k ∧ 4 * bernoulliResidueLength r (bernoulliPhaseScale k : ℝ) * ∑ q ∈ divisorCoinsBelow (∏ p ∈ T, p) r, q ≤ bernoulliSeedScale k * r := by filter_upwards [bernoulli_coefficient_cost_eventually_uniform hC] with k hk intro T hT hcard r hr hlog apply primeProduct_coefficient_cost hT exact hk r (2 ^ T.card) hr hlog (Nat.pow_le_pow_right (by omega) hcard) theorem divisorLogSupport_mono_dvd {n m : ℕ} (hnm : n ∣ m) (hm : m ≠ 0) (d : ℝ) : divisorLogSupport n d ⊆ divisorLogSupport m d := by intro x hx obtain ⟨q, hq⟩ := Set.mem_iUnion.mp hx have hqm : (q : ℕ) ∈ m.divisors := Nat.mem_divisors.mpr ⟨(Nat.mem_divisors.mp q.property).1.trans hnm, hm⟩ exact Set.mem_iUnion.mpr ⟨⟨q, hqm⟩, hq⟩ theorem divisorLogSupport_missing_mono {n m : ℕ} (hnm : n ∣ m) (hm : m ≠ 0) {a b c d e : ℝ} (hca : c ≤ a) (hbd : b ≤ d) : volume.real (Set.Icc a b \ divisorLogSupport m e) ≤ volume.real (Set.Icc c d \ divisorLogSupport n e) := by apply MeasureTheory.measureReal_mono · exact Set.sdiff_subset_sdiff (Set.Icc_subset_Icc hca hbd) (divisorLogSupport_mono_dvd hnm hm e) · exact MeasureTheory.measure_ne_top_of_subset Set.sdiff_subset isCompact_Icc.measure_ne_top end Erdos859Verification end /- Inlined development module: CoreBasePairEvent.lean -/ section /- An actual past event combines a proper core, base support, and adaptive pair filling. -/ open Finset Filter Real MeasureTheory open scoped Topology Classical namespace Erdos859Verification noncomputable def coreBasePairBaseSet (C : ℝ) (s : ℕ) (S : Finset ℕ) : Set ℝ := primeSubsetSumSupport S (coreBaseThickness (coreRateTotalLength s)) ∩ Set.Icc 0 (C*corePairScale s) noncomputable def coreBasePairUniverse (C : ℝ) (r₀ s : ℕ) : Finset ℕ := coreBasePrimeUniverse s ∪ corePairWindowsUniverse C r₀ s def CoreBasePairEvent (eta c C rho : ℝ) (r₀ s : ℕ) (T : Finset ℕ) : Prop := CoreSupportCountEvent eta s (coreBaseThickness (coreRateTotalLength s)) (c*corePairScale s) (C*corePairScale s) (18*(coreRateTotalLength s:ℝ)) (T∩coreBasePrimeUniverse s) ∧ PrimePairCombinedSuccess (C*corePairScale s) rho (32*primeLogOddsErrorConstant) (coreBasePairBaseSet C s (T∩coreBasePrimeUniverse s)) (corePairInitialWindows C r₀ s) (corePairRefinementWindows C r₀ s) T theorem isCompact_coreBasePairBaseSet (C : ℝ) (s : ℕ) (S : Finset ℕ) : IsCompact (coreBasePairBaseSet C s S) := (isCompact_primeSubsetSumSupport _ _).inter_right isClosed_Icc theorem CoreSupportCountEvent.mono_horizon {eta d threshold horizon horizon' countCap : ℝ} {s : ℕ} {T : Finset ℕ} (hH : horizon≤horizon') (h : CoreSupportCountEvent eta s d threshold horizon countCap T) : CoreSupportCountEvent eta s d threshold horizon' countCap T := by refine ⟨h.1,h.2.1.trans ?_,h.2.2⟩ exact measureReal_mono (Set.inter_subset_inter Set.Subset.rfl (Set.Icc_subset_Icc le_rfl hH)) ((isCompact_primeSubsetSumSupport T d).inter_right isClosed_Icc).measure_ne_top theorem coreBase_support_count_probability_large_horizon {eta lam : ℝ} (heta : 0