/- Erdos 272: the Szabo strong variant. The final theorem is Bounty.target, with exactly the task's requested type. All combinatorial reductions used in the proof are proved below. Proof outline: private witnesses and progression matching give the bound for common-point families and for families with a long common interval core. Trace counts give a common point for the crooked members after a linear loss. Straddling estimates and one-sided endpoint stability then give the required long-core structure. The lower construction and upper bound yield the big-O statement. Pinned environment: Lean 4.33.1; FormalConjectures 8432eac998110a563e03df65a28c117e97c8c142; Mathlib 0df444a360eaa60ab8c11dca51a86af692955474. -/ section open Finset Filter Asymptotics theorem arithInterSet_empty (N : ℕ) : Erdos272.IsArithInterSet N ∅ := by simp [Erdos272.IsArithInterSet] theorem admissible_card_le_pow {N : ℕ} {A : Finset (Finset ℕ)} (hA : Erdos272.IsArithInterSet N A) : A.card ≤ 2 ^ N := by have h := Finset.card_le_card hA.1 simpa using h theorem admissible_cards_nonempty (N : ℕ) : {m : ℕ | ∃ A : Finset (Finset ℕ), ∃ (_ : Erdos272.IsArithInterSet N A), A.card = m}.Nonempty := by exact ⟨0, ∅, arithInterSet_empty N, rfl⟩ theorem admissible_cards_bddAbove (N : ℕ) : BddAbove {m : ℕ | ∃ A : Finset (Finset ℕ), ∃ (_ : Erdos272.IsArithInterSet N A), A.card = m} := by refine ⟨2 ^ N, ?_⟩ rintro m ⟨A, hA, rfl⟩ exact admissible_card_le_pow hA theorem card_le_max {N : ℕ} {A : Finset (Finset ℕ)} (hA : Erdos272.IsArithInterSet N A) : A.card ≤ Erdos272.maxArithInterCard N := by exact le_csSup (admissible_cards_bddAbove N) ⟨A, hA, rfl⟩ theorem max_is_attained (N : ℕ) : ∃ A : Finset (Finset ℕ), Erdos272.IsArithInterSet N A ∧ A.card = Erdos272.maxArithInterCard N := by obtain ⟨A, hA, heq⟩ := Nat.sSup_mem (admissible_cards_nonempty N) (admissible_cards_bddAbove N) exact ⟨A, hA, heq⟩ theorem nonempty_small_isAP {s : Finset ℕ} (hs : s.Nonempty) (hcard : s.card ≤ 2) : ∃ l > 0, (s : Set ℕ).IsAPOfLength l := by have hpos := Finset.card_pos.mpr hs by_cases h : s.card = 1 · obtain ⟨a, rfl⟩ := Finset.card_eq_one.mp h exact ⟨1, by norm_num, Set.IsAPOfLength.one.mpr ⟨a, by simp⟩⟩ · have htwo : s.card = 2 := by omega obtain ⟨a, b, hab, rfl⟩ := Finset.card_eq_two.mp htwo refine ⟨2, by norm_num, ?_⟩ rw [Finset.coe_pair] rcases lt_or_gt_of_ne hab with hab | hba · exact Nat.isAPOfLength_pair hab · rw [Set.pair_comm] exact Nat.isAPOfLength_pair hba theorem small_star_admissible {N c : ℕ} {A : Finset (Finset ℕ)} (hsub : A ⊆ (Finset.Icc 1 N).powerset) (hc : ∀ s ∈ A, c ∈ s) (hsize : ∀ s ∈ A, s.card ≤ 3) : Erdos272.IsArithInterSet N A := by refine ⟨hsub, ?_⟩ intro s hs t ht hst apply nonempty_small_isAP ⟨c, Finset.mem_inter.mpr ⟨hc s hs, hc t ht⟩⟩ by_contra h have hthree : 3 ≤ (s ∩ t).card := by omega have heqs : s ∩ t = s := Finset.eq_of_subset_of_card_le Finset.inter_subset_left ((hsize s hs).trans hthree) have heqt : s ∩ t = t := Finset.eq_of_subset_of_card_le Finset.inter_subset_right ((hsize t ht).trans hthree) exact hst (heqs.symm.trans heqt) theorem insert_injective_fixed_card {α : Type*} [DecidableEq α] {c : α} {s t : Finset α} (hcard : s.card = t.card) (h : insert c s = insert c t) : s = t := by by_cases hs : c ∈ s · have ht : c ∈ t := by by_contra ht have hh := congrArg Finset.card h simp [Finset.insert_eq_of_mem hs, Finset.card_insert_of_notMem ht] at hh omega simpa [Finset.insert_eq_of_mem hs, Finset.insert_eq_of_mem ht] using h · have ht : c ∉ t := by intro ht have hh := congrArg Finset.card h simp [Finset.insert_eq_of_mem ht, Finset.card_insert_of_notMem hs] at hh omega apply Finset.ext intro x have hh := Finset.ext_iff.mp h x by_cases hx : x = c · subst x simp [hs, ht] · simpa [hx] using hh /-- Pairs in `[1,N]`, enlarged to contain 1, together with the singleton `{1}`. -/ def lowerFamily (N : ℕ) : Finset (Finset ℕ) := insert {1} (((Finset.Icc 1 N).powersetCard 2).image (insert 1)) theorem lowerFamily_admissible {N : ℕ} (hN : 1 ≤ N) : Erdos272.IsArithInterSet N (lowerFamily N) := by apply small_star_admissible (c := 1) · intro s hs rcases Finset.mem_insert.mp hs with rfl | hs · simp [hN] · obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hs exact Finset.mem_powerset.mpr (Finset.insert_subset (Finset.mem_Icc.mpr ⟨le_rfl, hN⟩) (Finset.mem_powersetCard.mp ht).1) · intro s hs rcases Finset.mem_insert.mp hs with rfl | hs · simp · obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hs simp · intro s hs rcases Finset.mem_insert.mp hs with rfl | hs · simp · obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hs have hh := Finset.card_insert_le 1 t rw [(Finset.mem_powersetCard.mp ht).2] at hh exact hh theorem card_lowerFamily (N : ℕ) : (lowerFamily N).card = N.choose 2 + 1 := by have hinj : Set.InjOn (insert 1) (((Finset.Icc 1 N).powersetCard 2) : Set (Finset ℕ)) := by intro s hs t ht heq exact insert_injective_fixed_card ((Finset.mem_powersetCard.mp hs).2.trans (Finset.mem_powersetCard.mp ht).2.symm) heq have hnot : {1} ∉ (((Finset.Icc 1 N).powersetCard 2).image (insert 1)) := by intro h obtain ⟨s, hs, heq⟩ := Finset.mem_image.mp h have hh : s.card ≤ ({1} : Finset ℕ).card := by rw [← heq] exact Finset.card_le_card (Finset.subset_insert 1 s) simp [(Finset.mem_powersetCard.mp hs).2] at hh rw [lowerFamily, Finset.card_insert_of_notMem hnot, Finset.card_image_of_injOn hinj, Finset.card_powersetCard] simp theorem lower_bound {N : ℕ} (hN : 1 ≤ N) : N.choose 2 + 1 ≤ Erdos272.maxArithInterCard N := by rw [← card_lowerFamily] exact card_le_max (lowerFamily_admissible hN) theorem lower_bound_real {N : ℕ} (hN : 1 ≤ N) : (N : ℝ)^2 / 2 - (N : ℝ) / 2 + 1 ≤ (Erdos272.maxArithInterCard N : ℝ) := by have h : ((N.choose 2 + 1 : ℕ) : ℝ) ≤ (Erdos272.maxArithInterCard N : ℝ) := Nat.cast_le.mpr (lower_bound hN) rw [Nat.cast_add, Nat.cast_one, Nat.cast_choose_two] at h nlinarith /-- The finite upper bound still required to finish the proposed proof. -/ def FiniteUpperBound : Prop := ∃ C : ℝ, ∃ N₀ : ℕ, ∀ N : ℕ, N₀ ≤ N → ∀ A : Finset (Finset ℕ), Erdos272.IsArithInterSet N A → (A.card : ℝ) ≤ (N : ℝ)^2 / 2 + C * (N : ℝ) /-- A conditional reduction, not a proof of the requested unconditional theorem. -/ theorem target_of_finite_upper_bound (hupper : FiniteUpperBound) : fcTypeOfName% "Erdos272.erdos_272.variants.szabo_strong" := by rcases hupper with ⟨C, N₀, hupper⟩ refine Asymptotics.IsBigO.of_bound (max |C| 1) ?_ filter_upwards [Filter.eventually_ge_atTop (max N₀ 1)] with N hN have hN₀ : N₀ ≤ N := (le_max_left _ _).trans hN have hN₁ : 1 ≤ N := (le_max_right _ _).trans hN obtain ⟨A, hA, hcard⟩ := max_is_attained N have hupperN := hupper N hN₀ A hA rw [hcard] at hupperN have hlowerN := lower_bound_real hN₁ have hC : C ≤ max |C| 1 := (le_abs_self C).trans (le_max_left _ _) have hone : (1 : ℝ) ≤ max |C| 1 := le_max_right _ _ have hNnonneg : (0 : ℝ) ≤ N := Nat.cast_nonneg N simp only [Real.norm_eq_abs, abs_of_nonneg hNnonneg] refine abs_le.mpr ⟨?_, ?_⟩ · nlinarith [mul_le_mul_of_nonneg_right hone hNnonneg] · nlinarith [mul_le_mul_of_nonneg_right hC hNnonneg] theorem finite_upper_bound_of_target (h : fcTypeOfName% "Erdos272.erdos_272.variants.szabo_strong") : FiniteUpperBound := by obtain ⟨C, hC⟩ := Asymptotics.isBigO_iff.mp h obtain ⟨N₀, hC⟩ := Filter.eventually_atTop.mp hC refine ⟨C, N₀, ?_⟩ intro N hN A hA have hbound := hC N hN have hNnonneg : (0 : ℝ) ≤ N := Nat.cast_nonneg N simp only [Real.norm_eq_abs, abs_of_nonneg hNnonneg] at hbound have hu := (abs_le.mp hbound).2 have hcard : (A.card : ℝ) ≤ (Erdos272.maxArithInterCard N : ℝ) := Nat.cast_le.mpr (card_le_max hA) linarith theorem target_iff_finite_upper_bound : (fcTypeOfName% "Erdos272.erdos_272.variants.szabo_strong") ↔ FiniteUpperBound := ⟨finite_upper_bound_of_target, target_of_finite_upper_bound⟩ end section open Finset theorem range_image_isAP (a d k : ℕ) (hd : 0 < d) : (((Finset.range k).image (fun i => a + i * d) : Finset ℕ) : Set ℕ).IsAPOfLength k := by refine ⟨a, d, ?_, ?_⟩ · have hinj : Function.Injective (fun i : ℕ => a + i * d) := by intro i j hij nlinarith simp [Finset.card_image_of_injective _ hinj] · ext x simp theorem multiples_isAP {d M : ℕ} (hd : 0 < d) : (((Finset.Icc 0 M).filter (fun x => d ∣ x) : Finset ℕ) : Set ℕ).IsAPOfLength (↑(M / d + 1 : ℕ)) := by have heq : (Finset.Icc 0 M).filter (fun x => d ∣ x) = (Finset.range (M / d + 1)).image (fun i => 0 + i * d) := by ext x simp only [Finset.mem_filter, Finset.mem_Icc, Nat.zero_le, true_and, Finset.mem_image, Finset.mem_range, zero_add] constructor · rintro ⟨hx, hdvd⟩ refine ⟨x / d, ?_, Nat.div_mul_cancel hdvd⟩ exact Nat.lt_succ_of_le ((Nat.le_div_iff_mul_le hd).mpr (by simpa [Nat.div_mul_cancel hdvd] using hx)) · rintro ⟨i, hi, rfl⟩ exact ⟨(Nat.le_div_iff_mul_le hd).mp (Nat.le_of_lt_succ hi), dvd_mul_left d i⟩ rw [heq] exact range_image_isAP 0 d (M / d + 1) hd /-- The arithmetic hull of `0,a,b`, expressed by divisibility and an interval. -/ def hullZero (a b : ℕ) : Finset ℕ := (Finset.Icc 0 (max a b)).filter (fun x => a.gcd b ∣ x) theorem gcd_mem_hullZero {a : ℕ} (b : ℕ) (ha : 0 < a) : a.gcd b ∈ hullZero a b := by exact Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨Nat.zero_le _, (Nat.gcd_le_left b ha).trans (le_max_left _ _)⟩, dvd_rfl⟩ /-- Closure under the hulls from a closest positive point forces a progression. -/ theorem hullZero_closed_isAP {s : Finset ℕ} {a : ℕ} (ha : a ∈ s) (hapos : 0 < a) (hmin : ∀ b ∈ s, 0 < b → a ≤ b) (hclosed : ∀ b ∈ s, hullZero a b ⊆ s) : ∃ l > 0, (s : Set ℕ).IsAPOfLength l := by have hne : s.Nonempty := ⟨a, ha⟩ have hdvd : ∀ b ∈ s, a ∣ b := by intro b hb have hgmem : a.gcd b ∈ s := hclosed b hb (gcd_mem_hullZero b hapos) have hgpos : 0 < a.gcd b := Nat.gcd_pos_of_pos_left b hapos have heq : a.gcd b = a := le_antisymm (Nat.gcd_le_left b hapos) (hmin _ hgmem hgpos) rw [← heq] exact Nat.gcd_dvd_right a b let M := s.max' hne have hMmem : M ∈ s := Finset.max'_mem s hne have hgcd : a.gcd M = a := Nat.gcd_eq_left_iff_dvd.mpr (hdvd M hMmem) have heq : s = (Finset.Icc 0 M).filter (fun x => a ∣ x) := by apply Finset.Subset.antisymm · intro x hx exact Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨Nat.zero_le _, Finset.le_max' s x hx⟩, hdvd x hx⟩ · intro x hx apply hclosed M hMmem have haM : a ≤ M := Finset.le_max' s a ha simpa [hullZero, max_eq_right haM, hgcd] using hx refine ⟨(M / a + 1 : ℕ), by positivity, ?_⟩ rw [heq] exact multiples_isAP hapos /-- A non-progression has a failed gcd hull from every closest positive point. -/ theorem closest_positive_witness {s : Finset ℕ} {a : ℕ} (ha : a ∈ s) (hapos : 0 < a) (hmin : ∀ b ∈ s, 0 < b → a ≤ b) (hcrooked : ¬ ∃ l > 0, (s : Set ℕ).IsAPOfLength l) : ∃ b ∈ s, ¬ hullZero a b ⊆ s := by by_contra h push Not at h exact hcrooked (hullZero_closed_isAP ha hapos hmin h) theorem finset_ap_representation {s : Finset ℕ} {l : ℕ∞} (h : (s : Set ℕ).IsAPOfLength l) : ∃ a d : ℕ, ∀ x : ℕ, x ∈ s ↔ ∃ i < s.card, a + i * d = x := by have hl : (s.card : ℕ∞) = l := by simpa using h.card obtain ⟨a, d, heq⟩ := h.eq refine ⟨a, d, ?_⟩ intro x change x ∈ (s : Set ℕ) ↔ _ rw [heq] simp [← hl] /-- A progression containing the three points contains their gcd hull. -/ theorem hullZero_subset_of_isAP {s : Finset ℕ} {l : ℕ∞} {u v : ℕ} (hAP : (s : Set ℕ).IsAPOfLength l) (hzero : 0 ∈ s) (hu : u ∈ s) (hv : v ∈ s) (hupos : 0 < u) : hullZero u v ⊆ s := by obtain ⟨a, d, hrep⟩ := finset_ap_representation hAP obtain ⟨i₀, hi₀, h₀⟩ := (hrep 0).mp hzero have ha : a = 0 := by omega subst a obtain ⟨i, hi, hui⟩ := (hrep u).mp hu obtain ⟨j, hj, hvj⟩ := (hrep v).mp hv simp only [zero_add] at hui hvj hrep have hd : 0 < d := by nlinarith have hdu : d ∣ u := by rw [← hui]; exact dvd_mul_left d i have hdv : d ∣ v := by rw [← hvj]; exact dvd_mul_left d j intro x hx obtain ⟨hxrange, hxdiv⟩ := Finset.mem_filter.mp hx have hxmax : x ≤ max u v := (Finset.mem_Icc.mp hxrange).2 have hdx : d ∣ x := (Nat.dvd_gcd hdu hdv).trans hxdiv have hdivmul : x / d * d = x := Nat.div_mul_cancel hdx have humax : u ≤ max i j * d := by nlinarith [le_max_left i j] have hvmax : v ≤ max i j * d := by nlinarith [le_max_right i j] have hxbound : x ≤ max i j * d := hxmax.trans (max_le humax hvmax) have hindex : x / d ≤ max i j := Nat.le_of_mul_le_mul_right (by simpa [hdivmul] using hxbound) hd exact (hrep x).mpr ⟨x / d, hindex.trans_lt (max_lt_iff.mpr ⟨hi, hj⟩), hdivmul⟩ /-- A failed hull is private among progression-intersecting sets containing zero. -/ theorem hullZero_witness_private {F : Finset (Finset ℕ)} (hF : (F : Set (Finset ℕ)).Pairwise fun s t => ∃ l > 0, ((s ∩ t : Finset ℕ) : Set ℕ).IsAPOfLength l) (hzero : ∀ s ∈ F, 0 ∈ s) {s t : Finset ℕ} (hs : s ∈ F) (ht : t ∈ F) {a b : ℕ} (ha : a ∈ s) (hb : b ∈ s) (hapos : 0 < a) (hfail : ¬ hullZero a b ⊆ s) (hat : a ∈ t) (hbt : b ∈ t) : t = s := by by_contra hne obtain ⟨l, hl, hAP⟩ := hF hs ht (fun hst => hne hst.symm) have hh := hullZero_subset_of_isAP hAP (Finset.mem_inter.mpr ⟨hzero s hs, hzero t ht⟩) (Finset.mem_inter.mpr ⟨ha, hat⟩) (Finset.mem_inter.mpr ⟨hb, hbt⟩) hapos exact hfail (hh.trans Finset.inter_subset_left) end section open Finset theorem prod_le_card_succ_mul_prod_pred (s : Finset ℕ) (hs : ∀ p ∈ s, 2 ≤ p) : (∏ p ∈ s, p) ≤ (s.card + 1) * ∏ p ∈ s, (p - 1) := by induction s using Finset.induction_on_max with | empty => simp | insert a s hmax ih => have hnot : a ∉ s := by intro ha exact (lt_irrefl a) (hmax a ha) have ha : 2 ≤ a := hs a (Finset.mem_insert_self _ _) have hs' : ∀ p ∈ s, 2 ≤ p := fun p hp => hs p (Finset.mem_insert_of_mem hp) have hsub : s ⊆ Finset.Icc 2 (a - 1) := by intro p hp exact Finset.mem_Icc.mpr ⟨hs' p hp, by have := hmax p hp; omega⟩ have hcard := Finset.card_le_card hsub simp only [Nat.card_Icc] at hcard have hca : s.card + 2 ≤ a := by omega have hprod := Nat.mul_le_mul_left a (ih hs') have hcoef : a * (s.card + 1) ≤ (s.card + 2) * (a - 1) := by have hapred : a - 1 + 1 = a := by omega nlinarith have hprod' := Nat.mul_le_mul_right (∏ p ∈ s, (p - 1)) hcoef rw [Finset.prod_insert hnot, Finset.prod_insert hnot, Finset.card_insert_of_notMem hnot] nlinarith theorem le_primeFactors_card_succ_mul_totient (n : ℕ) : n ≤ (n.primeFactors.card + 1) * n.totient := by have hprime : ∀ p ∈ n.primeFactors, 2 ≤ p := fun p hp => (Nat.prime_of_mem_primeFactors hp).two_le have hprod := prod_le_card_succ_mul_prod_pred n.primeFactors hprime have hmult := Nat.mul_le_mul_left n.totient hprod have hidentity := Nat.totient_mul_prod_primeFactors n have hpos : 0 < ∏ p ∈ n.primeFactors, (p - 1) := Finset.prod_pos (fun p hp => by have := hprime p hp; omega) have hineq : n * (∏ p ∈ n.primeFactors, (p - 1)) ≤ ((n.primeFactors.card + 1) * n.totient) * (∏ p ∈ n.primeFactors, (p - 1)) := by nlinarith exact (mul_le_mul_iff_left₀ hpos).mp hineq theorem primeFactors_card_le_log_two {n : ℕ} (hn : n ≠ 0) : n.primeFactors.card ≤ Nat.log 2 n := by apply (Nat.le_log_iff_pow_le (by decide) hn).mpr calc 2 ^ n.primeFactors.card ≤ ∏ p ∈ n.primeFactors, p := Finset.pow_card_le_prod _ _ _ (fun p hp => (Nat.prime_of_mem_primeFactors hp).two_le) _ ≤ n := Nat.le_of_dvd (Nat.pos_of_ne_zero hn) (Nat.prod_primeFactors_dvd n) theorem le_log_succ_mul_totient (n : ℕ) : n ≤ (Nat.log 2 n + 1) * n.totient := by by_cases hn : n = 0 · simp [hn] · exact (le_primeFactors_card_succ_mul_totient n).trans (Nat.mul_le_mul_right _ (Nat.add_le_add_right (primeFactors_card_le_log_two hn) 1)) theorem totient_ratio_le_log_succ {n : ℕ} (hn : 0 < n) : (n : ℝ) / (n.totient : ℝ) ≤ (Nat.log 2 n : ℝ) + 1 := by have hp : (0 : ℝ) < n.totient := Nat.cast_pos.mpr (Nat.totient_pos.mpr hn) apply (div_le_iff₀ hp).mpr exact_mod_cast le_log_succ_mul_totient n end section open Finset theorem odd_reciprocal_sq_step {x : ℝ} (hx : 0 ≤ x) : 1 / (2 * x + 5) ^ 2 ≤ 1 / (4 * x + 8) - 1 / (4 * x + 12) := by have h4 : 0 < 2 * x + 4 := by positivity have h6 : 0 < 2 * x + 6 := by positivity calc 1 / (2 * x + 5) ^ 2 ≤ 1 / ((2 * x + 4) * (2 * x + 6)) := one_div_le_one_div_of_le (mul_pos h4 h6) (by nlinarith) _ = 1 / (4 * x + 8) - 1 / (4 * x + 12) := by have h8 : 4 * x + 8 ≠ 0 := by positivity have h12 : 4 * x + 12 ≠ 0 := by positivity field_simp ring theorem odd_reciprocal_sq_tail (N : ℕ) : (∑ k ∈ Finset.range N, 1 / (2 * (k : ℝ) + 5) ^ 2) ≤ 1 / 8 - 1 / (4 * (N : ℝ) + 8) := by induction N with | zero => norm_num | succ N ih => rw [Finset.sum_range_succ] have hs := odd_reciprocal_sq_step (Nat.cast_nonneg N) calc _ ≤ (1 / 8 - 1 / (4 * (N : ℝ) + 8)) + (1 / (4 * (N : ℝ) + 8) - 1 / (4 * (N : ℝ) + 12)) := add_le_add ih hs _ = _ := by push_cast; ring theorem odd_reciprocal_sq_sum (N : ℕ) : (∑ k ∈ Finset.range N, 1 / (2 * (k : ℝ) + 3) ^ 2) ≤ 17 / 72 := by cases N with | zero => norm_num | succ N => rw [Finset.sum_range_succ'] have heq : (∑ k ∈ Finset.range N, 1 / (2 * ((k + 1 : ℕ) : ℝ) + 3) ^ 2) = ∑ k ∈ Finset.range N, 1 / (2 * (k : ℝ) + 5) ^ 2 := by apply Finset.sum_congr rfl intro k hk push_cast congr 2; ring rw [heq] norm_num only [Nat.cast_zero, mul_zero, zero_add] have ht := odd_reciprocal_sq_tail N have hp : 0 ≤ 1 / (4 * (N : ℝ) + 8) := by positivity linarith def positiveMultiples (N d : ℕ) : Finset ℕ := (Finset.Icc 1 N).filter (fun a => d ∣ a) def divisorBlock (N d : ℕ) : Finset (ℕ × ℕ) := positiveMultiples N d ×ˢ positiveMultiples N d def coprimeSquare (N : ℕ) : Finset (ℕ × ℕ) := ((Finset.Icc 1 N) ×ˢ (Finset.Icc 1 N)).filter (fun p => p.1.Coprime p.2) def noncoprimeSquare (N : ℕ) : Finset (ℕ × ℕ) := ((Finset.Icc 1 N) ×ˢ (Finset.Icc 1 N)).filter (fun p => ¬p.1.Coprime p.2) theorem card_positiveMultiples_le (N : ℕ) {d : ℕ} (hd : 0 < d) : (positiveMultiples N d).card ≤ N / d := by have hmaps : Set.MapsTo (fun a : ℕ => a / d) (positiveMultiples N d : Set ℕ) (Finset.Icc 1 (N / d) : Set ℕ) := by intro a ha obtain ⟨haI, had⟩ := Finset.mem_filter.mp ha obtain ⟨ha1, haN⟩ := Finset.mem_Icc.mp haI exact Finset.mem_Icc.mpr ⟨Nat.div_pos (Nat.le_of_dvd ha1 had) hd, Nat.div_le_div_right haN⟩ have hinj : Set.InjOn (fun a : ℕ => a / d) (positiveMultiples N d : Set ℕ) := by intro a ha b hb hab have hda := (Finset.mem_filter.mp ha).2 have hdb := (Finset.mem_filter.mp hb).2 calc a = a / d * d := (Nat.div_mul_cancel hda).symm _ = b / d * d := congrArg (fun k => k * d) hab _ = b := Nat.div_mul_cancel hdb simpa using Finset.card_le_card_of_injOn (fun a : ℕ => a / d) hmaps hinj theorem card_divisorBlock_le (N : ℕ) {d : ℕ} (hd : 0 < d) : (divisorBlock N d).card ≤ (N / d) ^ 2 := by have hh := card_positiveMultiples_le N hd simp only [divisorBlock, Finset.card_product] nlinarith theorem card_divisorBlock_real_le (N : ℕ) {d : ℕ} (hd : 0 < d) : ((divisorBlock N d).card : ℝ) ≤ (N : ℝ) ^ 2 / (d : ℝ) ^ 2 := by have hdR : (0 : ℝ) < d := Nat.cast_pos.mpr hd have hquot : ((N / d : ℕ) : ℝ) ≤ (N : ℝ) / (d : ℝ) := by apply (le_div_iff₀ hdR).mpr exact_mod_cast Nat.div_mul_le_self N d have hsq := (sq_le_sq₀ (Nat.cast_nonneg (N / d)) (div_nonneg (Nat.cast_nonneg N) hdR.le)).mpr hquot have hc : ((divisorBlock N d).card : ℝ) ≤ ((N / d : ℕ) : ℝ) ^ 2 := by exact_mod_cast card_divisorBlock_le N hd exact hc.trans (by simpa [div_pow] using hsq) theorem noncoprimeSquare_subset_blocks (N : ℕ) : noncoprimeSquare N ⊆ divisorBlock N 2 ∪ (Finset.range N).biUnion (fun k => divisorBlock N (2 * k + 3)) := by rintro ⟨a, b⟩ hp obtain ⟨hpI, hcop⟩ := Finset.mem_filter.mp hp obtain ⟨haI, hbI⟩ := Finset.mem_product.mp hpI obtain ⟨ha1, haN⟩ := Finset.mem_Icc.mp haI obtain ⟨hb1, hbN⟩ := Finset.mem_Icc.mp hbI have hpos : 0 < a.gcd b := Nat.gcd_pos_of_pos_left b ha1 have hne : a.gcd b ≠ 1 := hcop have hle : a.gcd b ≤ N := (Nat.gcd_le_left b ha1).trans haN have hblock (d : ℕ) (hd : d ∣ a.gcd b) : (a, b) ∈ divisorBlock N d := by exact Finset.mem_product.mpr ⟨Finset.mem_filter.mpr ⟨haI, hd.trans (Nat.gcd_dvd_left a b)⟩, Finset.mem_filter.mpr ⟨hbI, hd.trans (Nat.gcd_dvd_right a b)⟩⟩ by_cases heven : 2 ∣ a.gcd b · exact Finset.mem_union_left _ (hblock 2 heven) · have hmod : a.gcd b % 2 = 1 := by have hnmod : a.gcd b % 2 ≠ 0 := by simpa [Nat.dvd_iff_mod_eq_zero] using heven have hm := Nat.mod_lt (a.gcd b) (by decide : 0 < 2) omega have hdiv := Nat.mod_add_div (a.gcd b) 2 let k := a.gcd b / 2 - 1 have hkg : 2 * k + 3 = a.gcd b := by dsimp [k]; omega have hkN : k < N := by dsimp [k]; omega apply Finset.mem_union_right apply Finset.mem_biUnion.mpr refine ⟨k, Finset.mem_range.mpr hkN, ?_⟩ rw [hkg] exact hblock _ dvd_rfl theorem card_noncoprimeSquare_le (N : ℕ) : (noncoprimeSquare N).card ≤ (divisorBlock N 2).card + ∑ k ∈ Finset.range N, (divisorBlock N (2 * k + 3)).card := by calc _ ≤ (divisorBlock N 2 ∪ (Finset.range N).biUnion (fun k => divisorBlock N (2 * k + 3))).card := Finset.card_le_card (noncoprimeSquare_subset_blocks N) _ ≤ (divisorBlock N 2).card + ((Finset.range N).biUnion (fun k => divisorBlock N (2 * k + 3))).card := Finset.card_union_le _ _ _ ≤ _ := Nat.add_le_add_left Finset.card_biUnion_le _ theorem card_noncoprimeSquare_real_le (N : ℕ) : ((noncoprimeSquare N).card : ℝ) ≤ 35 / 72 * (N : ℝ) ^ 2 := by have hcover : ((noncoprimeSquare N).card : ℝ) ≤ ((divisorBlock N 2).card : ℝ) + ∑ k ∈ Finset.range N, ((divisorBlock N (2 * k + 3)).card : ℝ) := by exact_mod_cast card_noncoprimeSquare_le N have hblocks := Finset.sum_le_sum (s := Finset.range N) (fun k _ => card_divisorBlock_real_le N (by omega : 0 < 2 * k + 3)) have htwo := card_divisorBlock_real_le N (by decide : 0 < 2) have hsum := odd_reciprocal_sq_sum N have hmain : ((noncoprimeSquare N).card : ℝ) ≤ (N : ℝ) ^ 2 / 4 + ∑ k ∈ Finset.range N, (N : ℝ) ^ 2 / (2 * (k : ℝ) + 3) ^ 2 := by have hh := hcover.trans (add_le_add htwo hblocks) norm_num only [Nat.cast_ofNat, Nat.cast_add, Nat.cast_mul, Nat.reducePow] at hh exact hh have hfactor : (∑ k ∈ Finset.range N, (N : ℝ) ^ 2 / (2 * (k : ℝ) + 3) ^ 2) = (N : ℝ) ^ 2 * ∑ k ∈ Finset.range N, 1 / (2 * (k : ℝ) + 3) ^ 2 := by rw [Finset.mul_sum] apply Finset.sum_congr rfl intro k hk ring rw [hfactor] at hmain nlinarith [mul_le_mul_of_nonneg_left hsum (sq_nonneg (N : ℝ))] theorem coprimeSquare_card_lower (N : ℕ) : 37 / 72 * (N : ℝ) ^ 2 ≤ ((coprimeSquare N).card : ℝ) := by have hp : (coprimeSquare N).card + (noncoprimeSquare N).card = N ^ 2 := by have hh := Finset.card_filter_add_card_filter_not (s := (Finset.Icc 1 N) ×ˢ (Finset.Icc 1 N)) (p := fun p : ℕ × ℕ => p.1.Coprime p.2) simpa [coprimeSquare, noncoprimeSquare, pow_two] using hh have hpR : ((coprimeSquare N).card : ℝ) + ((noncoprimeSquare N).card : ℝ) = (N : ℝ) ^ 2 := by exact_mod_cast hp have hh := card_noncoprimeSquare_real_le N linarith def upperCoprime (N : ℕ) : Finset (ℕ × ℕ) := ((Finset.Icc 1 N).sigma (fun b => (Finset.Icc 1 b).filter (fun a => b.Coprime a))).image (fun p : (Σ _ : ℕ, ℕ) => (p.2, p.1)) def summatoryTotient (N : ℕ) : ℕ := ∑ b ∈ Finset.Icc 1 N, b.totient theorem mem_upperCoprime {N a b : ℕ} : (a, b) ∈ upperCoprime N ↔ b ∈ Finset.Icc 1 N ∧ a ∈ Finset.Icc 1 b ∧ b.Coprime a := by constructor · intro h obtain ⟨⟨b', a'⟩, hp, heq⟩ := Finset.mem_image.mp h have h₁ : a' = a := congrArg Prod.fst heq have h₂ : b' = b := congrArg Prod.snd heq subst a' subst b' simpa only [Finset.mem_sigma, Finset.mem_filter] using hp · rintro ⟨hb, ha, hcop⟩ exact Finset.mem_image.mpr ⟨⟨b, a⟩, Finset.mem_sigma.mpr ⟨hb, Finset.mem_filter.mpr ⟨ha, hcop⟩⟩, rfl⟩ theorem card_coprime_Icc (b : ℕ) : ((Finset.Icc 1 b).filter (fun a => b.Coprime a)).card = b.totient := by have heq : Finset.Icc 1 b = Finset.Ico 1 (1 + b) := by ext a simp only [Finset.mem_Icc, Finset.mem_Ico] omega rw [heq] exact Nat.filter_coprime_Ico_eq_totient b 1 theorem card_upperCoprime (N : ℕ) : (upperCoprime N).card = summatoryTotient N := by have hinj : Function.Injective (fun p : (Σ _ : ℕ, ℕ) => (p.2, p.1)) := by rintro ⟨b, a⟩ ⟨d, c⟩ heq have h₁ : a = c := congrArg Prod.fst heq have h₂ : b = d := congrArg Prod.snd heq subst c subst d rfl rw [upperCoprime, Finset.card_image_of_injective _ hinj, Finset.card_sigma] exact Finset.sum_congr rfl (fun b _ => card_coprime_Icc b) theorem coprimeSquare_subset_upper (N : ℕ) : coprimeSquare N ⊆ upperCoprime N ∪ (upperCoprime N).image Prod.swap := by rintro ⟨a, b⟩ hp obtain ⟨hpI, hcop⟩ := Finset.mem_filter.mp hp obtain ⟨haI, hbI⟩ := Finset.mem_product.mp hpI by_cases hab : a ≤ b · exact Finset.mem_union_left _ (mem_upperCoprime.mpr ⟨hbI, Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp haI).1, hab⟩, hcop.symm⟩) · apply Finset.mem_union_right apply Finset.mem_image.mpr refine ⟨(b, a), mem_upperCoprime.mpr ?_, rfl⟩ exact ⟨haI, Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp hbI).1, by omega⟩, hcop⟩ theorem coprimeSquare_card_le_twice_totient (N : ℕ) : (coprimeSquare N).card ≤ 2 * summatoryTotient N := by have hcover := (Finset.card_le_card (coprimeSquare_subset_upper N)).trans (Finset.card_union_le _ _) have hsum := hcover.trans (Nat.add_le_add_left (Finset.card_image_le (f := Prod.swap)) _) simpa [card_upperCoprime, two_mul] using hsum theorem summatoryTotient_lower (N : ℕ) : 37 / 144 * (N : ℝ) ^ 2 ≤ (summatoryTotient N : ℝ) := by have hupper : ((coprimeSquare N).card : ℝ) ≤ 2 * (summatoryTotient N : ℝ) := by exact_mod_cast coprimeSquare_card_le_twice_totient N have hlower := coprimeSquare_card_lower N linarith /-- The prefix inequality required by the negative half of the matching. -/ theorem totient_matching_supply {m : ℕ} (hm : 108 ≤ m) : ((m : ℝ) ^ 2 + 3 * (m : ℝ)) / 2 ≤ 2 * (summatoryTotient m : ℝ) := by have hmR : (108 : ℝ) ≤ m := by exact_mod_cast hm have hquad := mul_nonneg (Nat.cast_nonneg m : (0 : ℝ) ≤ m) (sub_nonneg.mpr hmR) have hsum := summatoryTotient_lower m nlinarith /-- Supply of primitive positive pairs after removing the two small exceptions. -/ theorem totient_corner_supply {m : ℕ} (hm : 128 ≤ m) : (m : ℝ) ^ 2 / 5 ≤ (summatoryTotient m : ℝ) - 2 := by have hmR : (128 : ℝ) ≤ m := by exact_mod_cast hm have hsum := summatoryTotient_lower m nlinarith end section open Finset def axisPairs (m : ℕ) : Finset (ℕ × ℕ) := ((upperCoprime m).erase (1, 1)).erase (1, 2) theorem mem_axisPairs {m a b : ℕ} : (a, b) ∈ axisPairs m ↔ 1 ≤ a ∧ a < b ∧ 3 ≤ b ∧ b ≤ m ∧ a.Coprime b := by simp only [axisPairs, Finset.mem_erase, mem_upperCoprime, Finset.mem_Icc] constructor · rintro ⟨hne12, hne11, ⟨hb1, hbm⟩, ⟨ha1, hab⟩, hcop⟩ have hab' : a < b := by by_contra hlt have heq : a = b := by omega subst b have hone : a = 1 := by simpa using hcop exact hne11 (Prod.ext hone hone) have hb3 : 3 ≤ b := by by_contra hlt have hbeq : b = 2 := by omega have haeq : a = 1 := by omega exact hne12 (Prod.ext haeq hbeq) exact ⟨ha1, hab', hb3, hbm, hcop.symm⟩ · rintro ⟨ha1, hab, hb3, hbm, hcop⟩ refine ⟨?_, ?_, ⟨by omega, hbm⟩, ⟨ha1, hab.le⟩, hcop.symm⟩ · intro heq have hb := congrArg Prod.snd heq change b = 2 at hb omega · intro heq have hb := congrArg Prod.snd heq change b = 1 at hb omega theorem axisPairs_mono {m n : ℕ} (hmn : m ≤ n) : axisPairs m ⊆ axisPairs n := by rintro ⟨a, b⟩ hp rcases mem_axisPairs.mp hp with ⟨ha, hab, hb, hbm, hcop⟩ exact mem_axisPairs.mpr ⟨ha, hab, hb, hbm.trans hmn, hcop⟩ theorem card_axisPairs_add_two {m : ℕ} (hm : 2 ≤ m) : (axisPairs m).card + 2 = summatoryTotient m := by have h11 : (1, 1) ∈ upperCoprime m := mem_upperCoprime.mpr ⟨Finset.mem_Icc.mpr ⟨by omega, by omega⟩, by simp, by decide⟩ have h12 : (1, 2) ∈ (upperCoprime m).erase (1, 1) := by apply Finset.mem_erase.mpr exact ⟨by decide, mem_upperCoprime.mpr ⟨Finset.mem_Icc.mpr ⟨by decide, hm⟩, by simp, by decide⟩⟩ have hc11 := Finset.card_erase_add_one h11 have hc12 := Finset.card_erase_add_one h12 rw [card_upperCoprime] at hc11 change (((upperCoprime m).erase (1, 1)).erase (1, 2)).card + 2 = _ omega def triangleCells (m : ℕ) : Finset (ℕ × ℕ) := ((Finset.range (m + 1)).sigma (fun l => Finset.range (l + 1))).image (fun p : (Σ _ : ℕ, ℕ) => (p.1, p.2)) def noncoprimeTriangle (m : ℕ) : Finset (ℕ × ℕ) := (triangleCells m).filter (fun p => ¬p.1.Coprime p.2) theorem mem_triangleCells {m l r : ℕ} : (l, r) ∈ triangleCells m ↔ l ≤ m ∧ r ≤ l := by constructor · intro h obtain ⟨⟨l', r'⟩, hp, heq⟩ := Finset.mem_image.mp h have h₁ : l' = l := congrArg Prod.fst heq have h₂ : r' = r := congrArg Prod.snd heq subst l' subst r' simpa only [Finset.mem_sigma, Finset.mem_range, Nat.lt_succ_iff] using hp · rintro ⟨hl, hr⟩ refine Finset.mem_image.mpr ⟨⟨l, r⟩, ?_, rfl⟩ simpa only [Finset.mem_sigma, Finset.mem_range, Nat.lt_succ_iff] using And.intro hl hr theorem card_triangleCells (m : ℕ) : 2 * (triangleCells m).card = (m + 1) * (m + 2) := by have hinj : Function.Injective (fun p : (Σ _ : ℕ, ℕ) => (p.1, p.2)) := by rintro ⟨a, b⟩ ⟨c, d⟩ heq have h₁ : a = c := congrArg Prod.fst heq have h₂ : b = d := congrArg Prod.snd heq subst c subst d rfl have hc : (triangleCells m).card = ∑ l ∈ Finset.range (m + 1), (l + 1) := by simp [triangleCells, Finset.card_image_of_injective _ hinj, Finset.card_sigma] rw [hc] clear hc hinj induction m with | zero => simp | succ m ih => rw [Finset.sum_range_succ] nlinarith theorem card_noncoprimeTriangle_add_totient_le (m : ℕ) : (noncoprimeTriangle m).card + summatoryTotient m ≤ (triangleCells m).card := by have hsub : noncoprimeTriangle m ∪ (upperCoprime m).image Prod.swap ⊆ triangleCells m := by intro p hp rcases Finset.mem_union.mp hp with hp | hp · exact (Finset.mem_filter.mp hp).1 · obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hp rcases mem_upperCoprime.mp hab with ⟨hbI, haI, hcop⟩ exact mem_triangleCells.mpr ⟨(Finset.mem_Icc.mp hbI).2, (Finset.mem_Icc.mp haI).2⟩ have hdisj : Disjoint (noncoprimeTriangle m) ((upperCoprime m).image Prod.swap) := by rw [Finset.disjoint_left] intro p hp hq obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hq exact (Finset.mem_filter.mp hp).2 (mem_upperCoprime.mp hab).2.2 have hh := Finset.card_le_card hsub rw [Finset.card_union_of_disjoint hdisj, Finset.card_image_of_injective _ Prod.swap_injective, card_upperCoprime] at hh exact hh theorem noncoprimeTriangle_le_axisPairs_large {m : ℕ} (hm : 128 ≤ m) : (noncoprimeTriangle m).card ≤ (axisPairs m).card := by have hcards := card_noncoprimeTriangle_add_totient_le m have htriangle := card_triangleCells m have haxis := card_axisPairs_add_two (by omega : 2 ≤ m) have hsum := summatoryTotient_lower m have hcR : ((noncoprimeTriangle m).card : ℝ) + (summatoryTotient m : ℝ) ≤ ((triangleCells m).card : ℝ) := by exact_mod_cast hcards have htR : 2 * ((triangleCells m).card : ℝ) = ((m : ℝ) + 1) * ((m : ℝ) + 2) := by exact_mod_cast htriangle have haR : ((axisPairs m).card : ℝ) + 2 = (summatoryTotient m : ℝ) := by exact_mod_cast haxis have hmR : (128 : ℝ) ≤ m := by exact_mod_cast hm have hprod := mul_nonneg (Nat.cast_nonneg m : (0 : ℝ) ≤ m) (sub_nonneg.mpr hmR) apply Nat.cast_le (α := ℝ).mp nlinarith theorem noncoprimeTriangle_prefix_bound (m : ℕ) : (noncoprimeTriangle m).card ≤ (axisPairs m).card + 10000 := by by_cases hm : 128 ≤ m · exact (noncoprimeTriangle_le_axisPairs_large hm).trans (Nat.le_add_right _ _) · have hsub : noncoprimeTriangle m ⊆ triangleCells m := Finset.filter_subset _ _ have hcard := Finset.card_le_card hsub have htri := card_triangleCells m have hprod : (m + 1) * (m + 2) ≤ 128 * 129 := Nat.mul_le_mul (by omega) (by omega) omega abbrev NoncoprimeCell := {p : ℕ × ℕ // p.2 ≤ p.1 ∧ ¬p.1.Coprime p.2} abbrev AxisToken := (ℕ × ℕ) ⊕ Fin 10000 def axisNeighborhood (p : NoncoprimeCell) : Finset AxisToken := (axisPairs p.val.1).disjSum Finset.univ theorem axisNeighborhood_hall (S : Finset NoncoprimeCell) : S.card ≤ (S.biUnion axisNeighborhood).card := by classical rcases S.eq_empty_or_nonempty with rfl | hS · simp · obtain ⟨a, ha, hmax⟩ := Finset.exists_max_image S (fun p : NoncoprimeCell => p.val.1) hS have hmaps : Set.MapsTo (fun p : NoncoprimeCell => p.val) (S : Set NoncoprimeCell) (noncoprimeTriangle a.val.1 : Set (ℕ × ℕ)) := by intro p hp exact Finset.mem_filter.mpr ⟨mem_triangleCells.mpr ⟨hmax p hp, p.property.1⟩, p.property.2⟩ have hc := Finset.card_le_card_of_injOn (fun p : NoncoprimeCell => p.val) hmaps Subtype.coe_injective.injOn calc S.card ≤ (noncoprimeTriangle a.val.1).card := hc _ ≤ (axisPairs a.val.1).card + 10000 := noncoprimeTriangle_prefix_bound _ _ = (axisNeighborhood a).card := by simp [axisNeighborhood] _ ≤ (S.biUnion axisNeighborhood).card := Finset.card_le_card (Finset.subset_biUnion_of_mem axisNeighborhood ha) /-- One matching works simultaneously at every level, with at most 10000 dummy values. -/ theorem exists_axis_matching : ∃ f : NoncoprimeCell → AxisToken, Function.Injective f ∧ ∀ p, f p ∈ axisNeighborhood p := by classical exact (Finset.all_card_le_biUnion_card_iff_exists_injective axisNeighborhood).mp axisNeighborhood_hall end section open Finset abbrev ProgressionCell := {p : ℕ × ℕ // 3 ≤ p.1 + p.2} abbrev ClassifiedCell := (ℕ × ℕ) ⊕ (NoncoprimeCell ⊕ NoncoprimeCell) abbrev IntervalRawToken := (ℕ × ℕ) ⊕ (AxisToken ⊕ AxisToken) def classifyCell (p : ProgressionCell) : ClassifiedCell := if hc : p.val.1.Coprime p.val.2 then Sum.inl p.val else if hh : p.val.2 ≤ p.val.1 then Sum.inr (Sum.inl ⟨p.val, hh, hc⟩) else Sum.inr (Sum.inr ⟨p.val.swap, by simpa using (Nat.le_of_lt (lt_of_not_ge hh)), fun h => hc h.symm⟩) def unclassifyCell : ClassifiedCell → ℕ × ℕ | Sum.inl p => p | Sum.inr (Sum.inl p) => p.val | Sum.inr (Sum.inr p) => p.val.swap theorem unclassify_classify (p : ProgressionCell) : unclassifyCell (classifyCell p) = p.val := by unfold classifyCell split_ifs <;> simp [unclassifyCell] theorem classifyCell_injective : Function.Injective classifyCell := by intro p q hpq apply Subtype.ext have hh := congrArg unclassifyCell hpq simpa only [unclassify_classify] using hh def RawTokenValid (p : ProgressionCell) : IntervalRawToken → Prop | Sum.inl q => q = p.val ∧ q.1.Coprime q.2 | Sum.inr (Sum.inl q) => q ∈ (axisPairs p.val.1).disjSum (Finset.univ : Finset (Fin 10000)) | Sum.inr (Sum.inr q) => q ∈ (axisPairs p.val.2).disjSum (Finset.univ : Finset (Fin 10000)) theorem exists_interval_raw_matching : ∃ f : ProgressionCell → IntervalRawToken, Function.Injective f ∧ ∀ p, RawTokenValid p (f p) := by obtain ⟨g, hg, hmem⟩ := exists_axis_matching let f : ProgressionCell → IntervalRawToken := Sum.map id (Sum.map g g) ∘ classifyCell refine ⟨f, ?_, ?_⟩ · have hmap : Function.Injective (Sum.map (id : ℕ × ℕ → ℕ × ℕ) (Sum.map g g)) := Sum.map_injective.mpr ⟨Function.injective_id, Sum.map_injective.mpr ⟨hg, hg⟩⟩ exact hmap.comp classifyCell_injective · intro p dsimp [f, Function.comp_def] unfold classifyCell split_ifs with hc hh · exact ⟨rfl, hc⟩ · exact hmem ⟨p.val, hh, hc⟩ · exact hmem ⟨p.val.swap, by simpa using (Nat.le_of_lt (lt_of_not_ge hh)), fun h => hc h.symm⟩ def rawPair : IntervalRawToken → Option (ℤ × ℤ) | Sum.inl (l, r) => some (-(l : ℤ), (r : ℤ)) | Sum.inr (Sum.inl (Sum.inl (a, b))) => some (-(b : ℤ), -(a : ℤ)) | Sum.inr (Sum.inr (Sum.inl (a, b))) => some ((a : ℤ), (b : ℤ)) | Sum.inr (Sum.inl (Sum.inr _)) => none | Sum.inr (Sum.inr (Sum.inr _)) => none def encodeIntervalDummy : (Fin 10000 ⊕ Fin 10000) → IntervalRawToken | Sum.inl i => Sum.inr (Sum.inl (Sum.inr i)) | Sum.inr i => Sum.inr (Sum.inr (Sum.inr i)) def intervalDummyTokens : Finset IntervalRawToken := Finset.univ.image encodeIntervalDummy theorem encodeIntervalDummy_injective : Function.Injective encodeIntervalDummy := by intro a b h cases a <;> cases b <;> simp_all [encodeIntervalDummy] theorem card_intervalDummyTokens : intervalDummyTokens.card = 20000 := by simp [intervalDummyTokens, Finset.card_image_of_injective _ encodeIntervalDummy_injective] theorem rawPair_eq_none_iff (t : IntervalRawToken) : rawPair t = none ↔ t ∈ intervalDummyTokens := by rcases t with ⟨l, r⟩ | (⟨a, b⟩ | i) | (⟨a, b⟩ | i) <;> simp [rawPair, intervalDummyTokens, encodeIntervalDummy, Sum.exists] theorem coprime_cell_positive {p : ProgressionCell} (hc : p.val.1.Coprime p.val.2) : 0 < p.val.1 ∧ 0 < p.val.2 ∧ p.val.1 ≠ p.val.2 := by have hsize := p.property have hl : 0 < p.val.1 := by by_contra h have heq : p.val.1 = 0 := by omega have hr : p.val.2 = 1 := by simpa [heq] using hc omega have hr : 0 < p.val.2 := by by_contra h have heq : p.val.2 = 0 := by omega have hl' : p.val.1 = 1 := by simpa [heq] using hc omega refine ⟨hl, hr, ?_⟩ intro heq have h1 : p.val.2 = 1 := by simpa [heq] using hc omega def PositiveRawToken : IntervalRawToken → Prop | Sum.inl (l, r) => 0 < l ∧ 0 < r | Sum.inr (Sum.inl (Sum.inl (a, b))) => 0 < a ∧ 0 < b | Sum.inr (Sum.inr (Sum.inl (a, b))) => 0 < a ∧ 0 < b | Sum.inr (Sum.inl (Sum.inr _)) => True | Sum.inr (Sum.inr (Sum.inr _)) => True theorem rawTokenValid_positive {p : ProgressionCell} {t : IntervalRawToken} (h : RawTokenValid p t) : PositiveRawToken t := by rcases t with ⟨l, r⟩ | (⟨a, b⟩ | i) | (⟨a, b⟩ | i) · obtain ⟨heq, hc⟩ := h have hpos := coprime_cell_positive (p := p) (by simpa [← heq] using hc) simpa only [PositiveRawToken, ← heq] using And.intro hpos.1 hpos.2.1 · have hp := mem_axisPairs.mp (Finset.inl_mem_disjSum.mp h) exact ⟨hp.1, by omega⟩ · trivial · have hp := mem_axisPairs.mp (Finset.inl_mem_disjSum.mp h) exact ⟨hp.1, by omega⟩ · trivial theorem rawPair_some_injective {t s : IntervalRawToken} (ht : PositiveRawToken t) (hs : PositiveRawToken s) (hne : rawPair t ≠ none) (heq : rawPair t = rawPair s) : t = s := by rcases t with ⟨l, r⟩ | (⟨a, b⟩ | i) | (⟨a, b⟩ | i) <;> rcases s with ⟨l', r'⟩ | (⟨a', b'⟩ | i') | (⟨a', b'⟩ | i') <;> simp_all [PositiveRawToken, rawPair] /-- A contained primitive pair which forms no three-term progression with zero. -/ def PrimitiveBadPair (p : ProgressionCell) (q : ℤ × ℤ) : Prop := -(p.val.1 : ℤ) ≤ q.1 ∧ q.1 < q.2 ∧ q.2 ≤ (p.val.2 : ℤ) ∧ q.1 ≠ 0 ∧ q.2 ≠ 0 ∧ q.1.natAbs.Coprime q.2.natAbs ∧ q.1 + q.2 ≠ 0 ∧ 2 * q.1 ≠ q.2 ∧ q.1 ≠ 2 * q.2 theorem axis_pair_not_twice {m a b : ℕ} (h : (a, b) ∈ axisPairs m) : b ≠ 2 * a := by rcases mem_axisPairs.mp h with ⟨ha, hab, hb, hbm, hc⟩ intro heq have hd : a ∣ b := by rw [heq]; exact dvd_mul_left a 2 have hg := Nat.gcd_eq_left_iff_dvd.mpr hd have hg1 : a.gcd b = 1 := hc have ha1 : a = 1 := by omega omega theorem primitiveBadPair_mixed {p : ProgressionCell} (hc : p.val.1.Coprime p.val.2) : PrimitiveBadPair p (-(p.val.1 : ℤ), (p.val.2 : ℤ)) := by have hpos := coprime_cell_positive hc refine ⟨le_rfl, by omega, le_rfl, by omega, by omega, ?_, by omega, by omega, by omega⟩ simpa using hc theorem primitiveBadPair_negative {p : ProgressionCell} {a b : ℕ} (h : (a, b) ∈ axisPairs p.val.1) : PrimitiveBadPair p (-(b : ℤ), -(a : ℤ)) := by have hn := axis_pair_not_twice h rcases mem_axisPairs.mp h with ⟨ha, hab, hb, hbm, hc⟩ refine ⟨by omega, by omega, by omega, by omega, by omega, ?_, by omega, by omega, by omega⟩ simpa using hc.symm theorem primitiveBadPair_positive {p : ProgressionCell} {a b : ℕ} (h : (a, b) ∈ axisPairs p.val.2) : PrimitiveBadPair p ((a : ℤ), (b : ℤ)) := by have hn := axis_pair_not_twice h rcases mem_axisPairs.mp h with ⟨ha, hab, hb, hbm, hc⟩ refine ⟨by omega, by omega, by omega, by omega, by omega, ?_, by omega, by omega, by omega⟩ simpa using hc theorem rawTokenValid_pair {p : ProgressionCell} {t : IntervalRawToken} {q : ℤ × ℤ} (h : RawTokenValid p t) (hq : rawPair t = some q) : PrimitiveBadPair p q := by rcases t with ⟨l, r⟩ | (⟨a, b⟩ | i) | (⟨a, b⟩ | i) · obtain ⟨heq, hc⟩ := h have hpair : (-(l : ℤ), (r : ℤ)) = q := Option.some.inj hq rw [← hpair] have hcop : p.val.1.Coprime p.val.2 := by simpa [← heq] using hc simpa only [← heq] using primitiveBadPair_mixed hcop · have hpair : (-(b : ℤ), -(a : ℤ)) = q := Option.some.inj hq rw [← hpair] exact primitiveBadPair_negative (Finset.inl_mem_disjSum.mp h) · cases hq · have hpair : ((a : ℤ), (b : ℤ)) = q := Option.some.inj hq rw [← hpair] exact primitiveBadPair_positive (Finset.inl_mem_disjSum.mp h) · cases hq theorem not_isAP_triple_of_relations {u v : ℤ} (hu : u ≠ 0) (hv : v ≠ 0) (huv : u ≠ v) (hadd : u + v ≠ 0) (hdu : 2 * u ≠ v) (hdv : u ≠ 2 * v) : ¬ ∃ l : ℕ∞, (({0, u, v} : Finset ℤ) : Set ℤ).IsAPOfLength l := by rintro ⟨l, hAP⟩ have hcard : ({0, u, v} : Finset ℤ).card = 3 := by simp [hu.symm, hv.symm, huv] have hl : (3 : ℕ∞) = l := by simpa [hcard] using hAP.card obtain ⟨a, d, hset⟩ := hAP.eq have hrep (x : ℤ) : x ∈ ({0, u, v} : Finset ℤ) ↔ ∃ i : ℕ, i < 3 ∧ a + (i : ℤ) * d = x := by change x ∈ (({0, u, v} : Finset ℤ) : Set ℤ) ↔ _ rw [hset] simp [← hl] have ha : a = 0 ∨ a = u ∨ a = v := by have hh := (hrep a).mpr ⟨0, by decide, by simp⟩ simpa using hh have hb : a + d = 0 ∨ a + d = u ∨ a + d = v := by have hh := (hrep (a + d)).mpr ⟨1, by decide, by simp⟩ simpa using hh have hc : a + 2 * d = 0 ∨ a + 2 * d = u ∨ a + 2 * d = v := by have hh := (hrep (a + 2 * d)).mpr ⟨2, by decide, by simp⟩ simpa using hh have hd : d ≠ 0 := by intro hd obtain ⟨i, hi, hui⟩ := (hrep u).mp (by simp) obtain ⟨j, hj, hvj⟩ := (hrep v).mp (by simp) simp only [hd, mul_zero, add_zero] at hui hvj exact huv (hui.symm.trans hvj) rcases ha with ha | ha | ha <;> rcases hb with hb | hb | hb <;> rcases hc with hc | hc | hc <;> omega theorem primitiveBadPair_not_isAP {p : ProgressionCell} {q : ℤ × ℤ} (h : PrimitiveBadPair p q) : ¬ ∃ l : ℕ∞, (({0, q.1, q.2} : Finset ℤ) : Set ℤ).IsAPOfLength l := by rcases h with ⟨hleft, hlt, hright, hu, hv, hcop, hadd, hdu, hdv⟩ exact not_isAP_triple_of_relations hu hv hlt.ne hadd hdu hdv /-- Normalized form of the draft's progression matching lemma. -/ theorem exists_progression_pair_matching : ∃ f : ProgressionCell → Option (ℤ × ℤ), (∀ p q, f p = some q → PrimitiveBadPair p q) ∧ (∀ p p' q, f p = some q → f p' = some q → p = p') ∧ (∀ S : Finset ProgressionCell, (S.filter (fun p => f p = none)).card ≤ 20000) := by classical obtain ⟨g, hg, hvalid⟩ := exists_interval_raw_matching refine ⟨rawPair ∘ g, ?_, ?_, ?_⟩ · intro p q hpq exact rawTokenValid_pair (hvalid p) hpq · intro p p' q hp hp' apply hg apply rawPair_some_injective (rawTokenValid_positive (hvalid p)) (rawTokenValid_positive (hvalid p')) · change rawPair (g p) = some q at hp rw [hp] simp · exact hp.trans hp'.symm · intro S have hmaps : Set.MapsTo g ((S.filter (fun p => (rawPair ∘ g) p = none)) : Set ProgressionCell) (intervalDummyTokens : Set IntervalRawToken) := by intro p hp exact (rawPair_eq_none_iff (g p)).mp (Finset.mem_filter.mp hp).2 have hc := Finset.card_le_card_of_injOn g hmaps hg.injOn simpa only [card_intervalDummyTokens] using hc end section open Finset def natAP (a d k : ℕ) : Finset ℕ := (Finset.range k).image (fun i => a + i * d) theorem mem_natAP {a d k x : ℕ} : x ∈ natAP a d k ↔ ∃ i < k, a + i * d = x := by simp [natAP] theorem natAP_isAP {a d k : ℕ} (hd : 0 < d) : (natAP a d k : Set ℕ).IsAPOfLength k := range_image_isAP a d k hd theorem nat_ap_representation_pos {S : Finset ℕ} {l : ℕ∞} (hAP : (S : Set ℕ).IsAPOfLength l) (hcard : 2 ≤ S.card) : ∃ a d : ℕ, 0 < d ∧ ∀ x : ℕ, x ∈ S ↔ ∃ i < S.card, a + i * d = x := by obtain ⟨a, d, hrep⟩ := finset_ap_representation hAP refine ⟨a, d, ?_, hrep⟩ by_contra hd have hd0 : d = 0 := by omega have hsmall : S.card ≤ 1 := Finset.card_le_one.mpr (by intro x hx y hy obtain ⟨i, hi, hxi⟩ := (hrep x).mp hx obtain ⟨j, hj, hyj⟩ := (hrep y).mp hy simp only [hd0, mul_zero, add_zero] at hxi hyj exact hxi.symm.trans hyj) omega theorem nat_ap_eq_natAP {S : Finset ℕ} {l : ℕ∞} (hAP : (S : Set ℕ).IsAPOfLength l) (hcard : 2 ≤ S.card) : ∃ a d : ℕ, 0 < d ∧ S = natAP a d S.card := by obtain ⟨a, d, hd, hrep⟩ := nat_ap_representation_pos hAP hcard refine ⟨a, d, hd, ?_⟩ ext x exact (hrep x).trans mem_natAP.symm def ConsecutiveIn (S : Finset ℕ) (u v : ℕ) : Prop := u ∈ S ∧ v ∈ S ∧ u < v ∧ ∀ x ∈ S, ¬ (u < x ∧ x < v) theorem ConsecutiveIn.card_ge_two {S : Finset ℕ} {u v : ℕ} (h : ConsecutiveIn S u v) : 2 ≤ S.card := by have hsub : {u, v} ⊆ S := by simp [Finset.insert_subset_iff, h.1, h.2.1] have hh := Finset.card_le_card hsub simpa [h.2.2.1.ne] using hh theorem ConsecutiveIn.inter {S T : Finset ℕ} {u v : ℕ} (hS : ConsecutiveIn S u v) (huT : u ∈ T) (hvT : v ∈ T) : ConsecutiveIn (S ∩ T) u v := by exact ⟨Finset.mem_inter.mpr ⟨hS.1, huT⟩, Finset.mem_inter.mpr ⟨hS.2.1, hvT⟩, hS.2.2.1, fun x hx => hS.2.2.2 x (Finset.mem_inter.mp hx).1⟩ theorem ConsecutiveIn.union {S T : Finset ℕ} {u v : ℕ} (hS : ConsecutiveIn S u v) (hT : ConsecutiveIn T u v) : ConsecutiveIn (S ∪ T) u v := by refine ⟨Finset.mem_union_left _ hS.1, Finset.mem_union_left _ hS.2.1, hS.2.2.1, ?_⟩ intro x hx rcases Finset.mem_union.mp hx with hx | hx · exact hS.2.2.2 x hx · exact hT.2.2.2 x hx theorem natAP_step_of_consecutive {a d k u v : ℕ} (hd : 0 < d) (h : ConsecutiveIn (natAP a d k) u v) : d = v - u := by obtain ⟨i, hi, hui⟩ := mem_natAP.mp h.1 obtain ⟨j, hj, hvj⟩ := mem_natAP.mp h.2.1 have huv := h.2.2.1 have hij : i < j := by by_contra hh have hmul := Nat.mul_le_mul_right d (Nat.le_of_not_gt hh) omega have hnext : j = i + 1 := by by_contra hh have hgap : i + 1 < j := by omega have hx : a + (i + 1) * d ∈ natAP a d k := mem_natAP.mpr ⟨i + 1, hgap.trans hj, rfl⟩ have hleft : u < a + (i + 1) * d := by nlinarith have hright : a + (i + 1) * d < v := by have hmul := Nat.mul_lt_mul_of_pos_right hgap hd omega exact h.2.2.2 _ hx ⟨hleft, hright⟩ have hv : v = u + d := by rw [hnext] at hvj; nlinarith omega theorem nat_ap_eq_with_consecutive_gap {S : Finset ℕ} {l : ℕ∞} {u v : ℕ} (hAP : (S : Set ℕ).IsAPOfLength l) (hcon : ConsecutiveIn S u v) : ∃ a : ℕ, S = natAP a (v - u) S.card := by obtain ⟨a, d, hd, heq⟩ := nat_ap_eq_natAP hAP hcon.card_ge_two have hgap := natAP_step_of_consecutive hd (heq ▸ hcon) exact ⟨a, by simpa [hgap] using heq⟩ theorem natAP_union_overlap (a d k t m : ℕ) (ht : t < k) : natAP a d k ∪ natAP (a + t * d) d m = natAP a d (max k (t + m)) := by ext x simp only [Finset.mem_union, mem_natAP] constructor · rintro (⟨i, hi, rfl⟩ | ⟨j, hj, rfl⟩) · exact ⟨i, hi.trans_le (le_max_left _ _), rfl⟩ · refine ⟨t + j, (Nat.add_lt_add_left hj t).trans_le (le_max_right _ _), ?_⟩ ring · rintro ⟨i, hi, rfl⟩ by_cases hik : i < k · exact Or.inl ⟨i, hik, rfl⟩ · have hit : t ≤ i := by omega have him : i - t < m := by omega refine Or.inr ⟨i - t, him, ?_⟩ have hei : t + (i - t) = i := Nat.add_sub_of_le hit nlinarith theorem natAP_union_isAP_of_common_point {a b d k m u : ℕ} (hd : 0 < d) (huS : u ∈ natAP a d k) (huT : u ∈ natAP b d m) : ∃ l : ℕ∞, ((natAP a d k ∪ natAP b d m : Finset ℕ) : Set ℕ).IsAPOfLength l := by suffices ∀ a b k m, a ≤ b → u ∈ natAP a d k → u ∈ natAP b d m → ∃ l : ℕ∞, ((natAP a d k ∪ natAP b d m : Finset ℕ) : Set ℕ).IsAPOfLength l by rcases le_total a b with hab | hba · exact this a b k m hab huS huT · simpa only [Finset.union_comm] using this b a m k hba huT huS intro a b k m hab huS huT obtain ⟨i, hi, hui⟩ := mem_natAP.mp huS obtain ⟨j, hj, huj⟩ := mem_natAP.mp huT have hji : j ≤ i := by by_contra hh have hmul := Nat.mul_lt_mul_of_pos_right (Nat.lt_of_not_ge hh) hd omega have hb : b = a + (i - j) * d := by have hsub : j + (i - j) = i := Nat.add_sub_of_le hji nlinarith have ht : i - j < k := by omega rw [hb, natAP_union_overlap a d k (i - j) m ht] exact ⟨_, natAP_isAP hd⟩ theorem isAP_union_of_consecutive {S T : Finset ℕ} {u v : ℕ} (hS : ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hT : ∃ l : ℕ∞, (T : Set ℕ).IsAPOfLength l) (hconS : ConsecutiveIn S u v) (hconT : ConsecutiveIn T u v) : ∃ l : ℕ∞, ((S ∪ T : Finset ℕ) : Set ℕ).IsAPOfLength l := by obtain ⟨lS, hS⟩ := hS obtain ⟨lT, hT⟩ := hT obtain ⟨a, hSa⟩ := nat_ap_eq_with_consecutive_gap hS hconS obtain ⟨b, hTb⟩ := nat_ap_eq_with_consecutive_gap hT hconT have hd : 0 < v - u := Nat.sub_pos_of_lt hconS.2.2.1 rw [hSa, hTb] exact natAP_union_isAP_of_common_point hd (hSa ▸ hconS.1) (hTb ▸ hconT.1) end section open Finset def IsCrooked (S : Finset ℕ) : Prop := ¬ ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l def FixedGapAP (u v : ℕ) (S : Finset ℕ) : Prop := S = ∅ ∨ ((∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) ∧ ConsecutiveIn S u v) theorem fixedGapAP_empty (u v : ℕ) : FixedGapAP u v ∅ := Or.inl rfl theorem fixedGapAP_union {u v : ℕ} {S T : Finset ℕ} (hS : FixedGapAP u v S) (hT : FixedGapAP u v T) : FixedGapAP u v (S ∪ T) := by rcases hS with rfl | ⟨hAPs, hcons⟩ · simpa using hT rcases hT with rfl | ⟨hAPt, hcont⟩ · simpa [FixedGapAP] using Or.inr (And.intro hAPs hcons) · exact Or.inr ⟨isAP_union_of_consecutive hAPs hAPt hcons hcont, hcons.union hcont⟩ theorem union_closed_biUnion {α β : Type*} [DecidableEq α] {C : Finset α → Prop} (hzero : C ∅) (hunion : ∀ S T, C S → C T → C (S ∪ T)) (B : Finset β) (f : β → Finset α) (hf : ∀ b ∈ B, C (f b)) : C (B.biUnion f) := by classical induction B using Finset.induction_on with | empty => simpa using hzero | @insert b B hb ih => rw [Finset.biUnion_insert] exact hunion _ _ (hf b (Finset.mem_insert_self _ _)) (ih (fun c hc => hf c (Finset.mem_insert_of_mem hc))) theorem private_points_of_union_closed {α : Type*} [DecidableEq α] {F : Finset (Finset α)} {C : Finset α → Prop} (hzero : C ∅) (hunion : ∀ S T, C S → C T → C (S ∪ T)) (hnot : ∀ S ∈ F, ¬ C S) (hinter : (F : Set (Finset α)).Pairwise (fun S T => C (S ∩ T))) : ∀ S ∈ F, ∃ x ∈ S, ∀ T ∈ F, x ∈ T → T = S := by classical intro S hS let U := (F.erase S).biUnion (fun T => S ∩ T) have hUC : C U := union_closed_biUnion hzero hunion _ _ (by intro T hT obtain ⟨hne, hTF⟩ := Finset.mem_erase.mp hT exact hinter hS hTF (fun hST => hne hST.symm)) have hUsub : U ⊆ S := by intro x hx obtain ⟨T, hT, hxST⟩ := Finset.mem_biUnion.mp hx exact (Finset.mem_inter.mp hxST).1 have hnotSub : ¬ S ⊆ U := by intro hSU have heq : S = U := Finset.Subset.antisymm hSU hUsub exact hnot S hS (heq.symm ▸ hUC) obtain ⟨x, hxS, hxU⟩ := Finset.not_subset.mp hnotSub refine ⟨x, hxS, ?_⟩ intro T hT hxT by_contra hne apply hxU exact Finset.mem_biUnion.mpr ⟨T, Finset.mem_erase.mpr ⟨hne, hT⟩, Finset.mem_inter.mpr ⟨hxS, hxT⟩⟩ theorem card_le_of_private_points {α : Type*} [DecidableEq α] {F : Finset (Finset α)} {U : Finset α} (hsub : ∀ S ∈ F, S ⊆ U) (hprivate : ∀ S ∈ F, ∃ x ∈ S, ∀ T ∈ F, x ∈ T → T = S) : F.card ≤ U.card := by classical choose x hx hpriv using (fun S : {S // S ∈ F} => hprivate S.val S.property) have hmaps : Set.MapsTo x ((Finset.univ : Finset {S // S ∈ F}) : Set {S // S ∈ F}) (U : Set α) := by intro S hS exact hsub S.val S.property (hx S) have hinj : Function.Injective x := by intro S T heq apply Subtype.ext exact (hpriv S T.val T.property (by simpa only [heq] using hx T)).symm have hc := Finset.card_le_card_of_injOn x hmaps hinj.injOn simpa using hc theorem arithInterSet_mono {N : ℕ} {F G : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hGF : G ⊆ F) : Erdos272.IsArithInterSet N G := by refine ⟨hGF.trans hF.1, ?_⟩ intro S hS T hT hne exact hF.2 (hGF hS) (hGF hT) hne /-- At most `N` crooked members can have one specified consecutive pair. -/ theorem crooked_consecutive_card_le {N u v : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hcrooked : ∀ S ∈ F, IsCrooked S) (hconsecutive : ∀ S ∈ F, ConsecutiveIn S u v) : F.card ≤ N := by have hprivate : ∀ S ∈ F, ∃ x ∈ S, ∀ T ∈ F, x ∈ T → T = S := by apply private_points_of_union_closed (C := FixedGapAP u v) (fixedGapAP_empty u v) (fun S T hS hT => fixedGapAP_union hS hT) · intro S hS hclass rcases hclass with heq | ⟨hAP, hcon⟩ · have hu := (hconsecutive S hS).1 simp [heq] at hu · exact hcrooked S hS hAP · intro S hS T hT hne obtain ⟨l, hl, hAP⟩ := hF.2 hS hT hne exact Or.inr ⟨⟨l, hAP⟩, (hconsecutive S hS).inter (hconsecutive T hT).1 (hconsecutive T hT).2.1⟩ have hc := card_le_of_private_points (fun S hS => Finset.mem_powerset.mp (hF.1 hS)) hprivate simpa using hc end section open Finset noncomputable def blockMinima (S : Finset ℕ) : Finset ℕ := by classical exact S.filter (fun x => ∀ y ∈ S, y / 32 = x / 32 → x ≤ y) def ShortConsecutive (S : Finset ℕ) (p : ℕ × ℕ) : Prop := ConsecutiveIn S p.1 p.2 ∧ p.2 - p.1 ≤ 32 noncomputable def shortPairs (S : Finset ℕ) : Finset (ℕ × ℕ) := by classical exact (S ×ˢ S).filter (ShortConsecutive S) theorem card_blockMinima_le {N : ℕ} {S : Finset ℕ} (hsub : S ⊆ Finset.Icc 1 N) : (blockMinima S).card ≤ N / 32 + 1 := by classical have hmaps : Set.MapsTo (fun x : ℕ => x / 32) (blockMinima S : Set ℕ) (Finset.Icc 0 (N / 32) : Set ℕ) := by intro x hx have hxS := (Finset.mem_filter.mp hx).1 have hxN := (Finset.mem_Icc.mp (hsub hxS)).2 exact Finset.mem_Icc.mpr ⟨Nat.zero_le _, Nat.div_le_div_right hxN⟩ have hinj : Set.InjOn (fun x : ℕ => x / 32) (blockMinima S : Set ℕ) := by intro x hx y hy hxy obtain ⟨hxS, hxMin⟩ := Finset.mem_filter.mp hx obtain ⟨hyS, hyMin⟩ := Finset.mem_filter.mp hy exact le_antisymm (hxMin y hyS hxy.symm) (hyMin x hxS hxy) simpa using Finset.card_le_card_of_injOn (fun x : ℕ => x / 32) hmaps hinj theorem short_pair_ending_at_nonminimum {S : Finset ℕ} {x : ℕ} (hxS : x ∈ S) (hxMin : x ∉ blockMinima S) : ∃ z, (z, x) ∈ shortPairs S := by classical have hnot : ¬ ∀ y ∈ S, y / 32 = x / 32 → x ≤ y := by intro h exact hxMin (Finset.mem_filter.mpr ⟨hxS, h⟩) push Not at hnot obtain ⟨y, hyS, hquot, hyx⟩ := hnot let B := S.filter (fun z => z < x) have hyB : y ∈ B := Finset.mem_filter.mpr ⟨hyS, hyx⟩ have hB : B.Nonempty := ⟨y, hyB⟩ let z := B.max' hB have hzB : z ∈ B := Finset.max'_mem B hB obtain ⟨hzS, hzx⟩ := Finset.mem_filter.mp hzB have hyz : y ≤ z := Finset.le_max' B y hyB have hcon : ConsecutiveIn S z x := by refine ⟨hzS, hxS, hzx, ?_⟩ intro w hw hbetween have hwB : w ∈ B := Finset.mem_filter.mpr ⟨hw, hbetween.2⟩ have hwz : w ≤ z := Finset.le_max' B w hwB omega have hxmod := Nat.mod_add_div x 32 have hmodlt := Nat.mod_lt x (by decide : 0 < 32) have hydiv := Nat.div_mul_le_self y 32 have hgap : x - z ≤ 32 := by omega exact ⟨z, Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨hzS, hxS⟩, hcon, hgap⟩⟩ theorem card_nonminima_le_shortPairs (S : Finset ℕ) : (S \ blockMinima S).card ≤ (shortPairs S).card := by classical choose z hz using (fun x : {x // x ∈ S \ blockMinima S} => short_pair_ending_at_nonminimum (Finset.mem_sdiff.mp x.property).1 (Finset.mem_sdiff.mp x.property).2) have hmaps : Set.MapsTo (fun x : {x // x ∈ S \ blockMinima S} => (z x, x.val)) ((Finset.univ : Finset {x // x ∈ S \ blockMinima S}) : Set {x // x ∈ S \ blockMinima S}) (shortPairs S : Set (ℕ × ℕ)) := by intro x hx exact hz x have hinj : Function.Injective (fun x : {x // x ∈ S \ blockMinima S} => (z x, x.val)) := by intro x y hxy exact Subtype.ext (congrArg Prod.snd hxy) simpa using Finset.card_le_card_of_injOn _ hmaps hinj.injOn theorem card_le_shortPairs_add_blocks {N : ℕ} {S : Finset ℕ} (hsub : S ⊆ Finset.Icc 1 N) : S.card ≤ (shortPairs S).card + (N / 32 + 1) := by classical have hminsub : blockMinima S ⊆ S := Finset.filter_subset _ _ have hcard := Finset.card_sdiff_add_card_eq_card hminsub have hnon := card_nonminima_le_shortPairs S have hmin := card_blockMinima_le hsub omega theorem dense_set_many_short_pairs {N : ℕ} {S : Finset ℕ} (hN : 64 ≤ N) (hsub : S ⊆ Finset.Icc 1 N) (hsize : N < 16 * S.card) : N ≤ 64 * (shortPairs S).card := by have hcard := card_le_shortPairs_add_blocks hsub have hdiv := Nat.div_mul_le_self N 32 omega def shortPairUniverse (N : ℕ) : Finset (ℕ × ℕ) := ((Finset.Icc 1 N) ×ˢ (Finset.Icc 1 32)).image (fun p => (p.1, p.1 + p.2)) theorem card_shortPairUniverse (N : ℕ) : (shortPairUniverse N).card = 32 * N := by have hinj : Function.Injective (fun p : ℕ × ℕ => (p.1, p.1 + p.2)) := by rintro ⟨a, d⟩ ⟨b, e⟩ heq have h₁ : a = b := congrArg Prod.fst heq have h₂ : a + d = b + e := congrArg Prod.snd heq exact Prod.ext h₁ (by omega) simp [shortPairUniverse, Finset.card_image_of_injective _ hinj, Nat.mul_comm] theorem shortConsecutive_mem_universe {N : ℕ} {S : Finset ℕ} {p : ℕ × ℕ} (hsub : S ⊆ Finset.Icc 1 N) (hp : ShortConsecutive S p) : p ∈ shortPairUniverse N := by rcases p with ⟨u, v⟩ have huI := hsub hp.1.1 have huv := hp.1.2.2.1 have hgap := hp.2 exact Finset.mem_image.mpr ⟨(u, v - u), Finset.mem_product.mpr ⟨huI, Finset.mem_Icc.mpr ⟨by omega, hgap⟩⟩, Prod.ext rfl (by omega)⟩ theorem shortPairs_eq_bipartiteAbove {N : ℕ} {S : Finset ℕ} (hsub : S ⊆ Finset.Icc 1 N) : (by classical exact shortPairs S = Finset.bipartiteAbove ShortConsecutive (shortPairUniverse N) S) := by classical ext p simp only [shortPairs, Finset.mem_filter, Finset.mem_product, Finset.mem_bipartiteAbove] constructor · rintro ⟨hmem, hrel⟩ exact ⟨shortConsecutive_mem_universe hsub hrel, hrel⟩ · rintro ⟨hU, hrel⟩ exact ⟨⟨hrel.1.1, hrel.1.2.1⟩, hrel⟩ /-- The dense crooked members contribute only a linear number of sets. -/ theorem dense_crooked_card_le {N : ℕ} {F : Finset (Finset ℕ)} (hN : 64 ≤ N) (hF : Erdos272.IsArithInterSet N F) (hcrooked : ∀ S ∈ F, IsCrooked S) (hsize : ∀ S ∈ F, N < 16 * S.card) : F.card ≤ 2048 * N := by classical have hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N := fun S hS => Finset.mem_powerset.mp (hF.1 hS) have hlow : F.card * N ≤ 64 * ∑ S ∈ F, (shortPairs S).card := by have hh := Finset.sum_le_sum (s := F) (fun S hS => dense_set_many_short_pairs hN (hsub S hS) (hsize S hS)) simpa [← Finset.mul_sum] using hh have hdouble : (∑ S ∈ F, (shortPairs S).card) = ∑ p ∈ shortPairUniverse N, (Finset.bipartiteBelow ShortConsecutive F p).card := by calc _ = ∑ S ∈ F, (Finset.bipartiteAbove ShortConsecutive (shortPairUniverse N) S).card := Finset.sum_congr rfl (fun S hS => congrArg Finset.card (shortPairs_eq_bipartiteAbove (hsub S hS))) _ = _ := Finset.sum_card_bipartiteAbove_eq_sum_card_bipartiteBelow ShortConsecutive have hbelow : ∀ p ∈ shortPairUniverse N, (Finset.bipartiteBelow ShortConsecutive F p).card ≤ N := by intro p hp have hBF : Finset.bipartiteBelow ShortConsecutive F p ⊆ F := Finset.filter_subset _ _ apply crooked_consecutive_card_le (u := p.1) (v := p.2) (arithInterSet_mono hF hBF) · intro S hS exact hcrooked S (hBF hS) · intro S hS exact ((Finset.mem_bipartiteBelow ShortConsecutive).mp hS).2.1 have hupp : (∑ p ∈ shortPairUniverse N, (Finset.bipartiteBelow ShortConsecutive F p).card) ≤ (shortPairUniverse N).card * N := by simpa using Finset.sum_le_sum hbelow rw [hdouble] at hlow rw [card_shortPairUniverse] at hupp have hfinal : F.card * N ≤ (2048 * N) * N := by nlinarith exact Nat.le_of_mul_le_mul_right hfinal (by omega) end section open Finset theorem finset_ap_image_of_map_progressions {α β : Type*} [AddCommMonoid α] [AddCommMonoid β] [DecidableEq α] [DecidableEq β] {S : Finset α} {l : ℕ∞} (f g : α → β) (hinj : Function.Injective f) (hmap : ∀ (a d : α) (n : ℕ), f (a + n • d) = f a + n • g d) (hAP : (S : Set α).IsAPOfLength l) : ((S.image f : Finset β) : Set β).IsAPOfLength l := by obtain ⟨a, d, hAP⟩ := hAP refine ⟨f a, g d, ?_, ?_⟩ · simpa [Finset.card_image_of_injective _ hinj] using hAP.card · ext y rw [Finset.coe_image] constructor · rintro ⟨x, hx, rfl⟩ rw [hAP.eq] at hx obtain ⟨n, hn, rfl⟩ := hx exact ⟨n, hn, (hmap a d n).symm⟩ · rintro ⟨n, hn, hy⟩ refine ⟨a + n • d, ?_, ?_⟩ · rw [hAP.eq] exact ⟨n, hn, rfl⟩ · exact (hmap a d n).trans hy theorem nat_ap_cast_int {S : Finset ℕ} {l : ℕ∞} (hAP : (S : Set ℕ).IsAPOfLength l) : (((S.image (fun x : ℕ => (x : ℤ))) : Finset ℤ) : Set ℤ).IsAPOfLength l := by apply finset_ap_image_of_map_progressions (fun x : ℕ => (x : ℤ)) (fun x : ℕ => (x : ℤ)) Nat.cast_injective (fun a d n => by simp) hAP theorem int_ap_affine_image {S : Finset ℤ} {l : ℕ∞} {c d : ℤ} (hd : d ≠ 0) (hAP : (S : Set ℤ).IsAPOfLength l) : (((S.image (fun x => c + d * x)) : Finset ℤ) : Set ℤ).IsAPOfLength l := by apply finset_ap_image_of_map_progressions (fun x => c + d * x) (fun x => d * x) (fun x y hxy => mul_left_cancel₀ hd (add_left_cancel hxy)) (fun a b n => by simp only [nsmul_eq_mul]; ring) hAP theorem natAP_cast_eq_affine_interval (a d k i : ℕ) (hi : i < k) : (natAP a d k).image (fun x : ℕ => (x : ℤ)) = (Finset.Icc (-(i : ℤ)) ((k - 1 - i : ℕ) : ℤ)).image (fun z => ((a + i * d : ℕ) : ℤ) + (d : ℤ) * z) := by have hr : (k - 1 - i) + i + 1 = k := by omega have hrI : ((k - 1 - i : ℕ) : ℤ) + (i : ℤ) + 1 = (k : ℤ) := by exact_mod_cast hr ext x constructor · intro hx obtain ⟨n, hn, hnx⟩ := Finset.mem_image.mp hx obtain ⟨j, hj, hnj⟩ := mem_natAP.mp hn refine Finset.mem_image.mpr ⟨(j : ℤ) - (i : ℤ), Finset.mem_Icc.mpr ⟨by omega, by omega⟩, ?_⟩ rw [← hnx, ← hnj] push_cast ring · intro hx obtain ⟨z, hz, hzx⟩ := Finset.mem_image.mp hx obtain ⟨hzlo, hzhi⟩ := Finset.mem_Icc.mp hz have hznonneg : 0 ≤ z + (i : ℤ) := by omega let j := (z + (i : ℤ)).toNat have hji : (j : ℤ) = z + (i : ℤ) := Int.toNat_of_nonneg hznonneg have hj : j < k := by omega refine Finset.mem_image.mpr ⟨a + j * d, mem_natAP.mpr ⟨j, hj, rfl⟩, ?_⟩ rw [← hzx] push_cast rw [hji] ring def IsCenteredModel (c d : ℕ) (p : ProgressionCell) (S : Finset ℕ) : Prop := S.image (fun x : ℕ => (x : ℤ)) = (Finset.Icc (-(p.val.1 : ℤ)) (p.val.2 : ℤ)).image (fun z => (c : ℤ) + (d : ℤ) * z) theorem exists_centered_model {S : Finset ℕ} {l : ℕ∞} {c : ℕ} (hAP : (S : Set ℕ).IsAPOfLength l) (hcard : 4 ≤ S.card) (hc : c ∈ S) : ∃ d : ℕ, 0 < d ∧ ∃ p : ProgressionCell, IsCenteredModel c d p S := by obtain ⟨a, d, hd, heq⟩ := nat_ap_eq_natAP hAP (by omega) obtain ⟨i, hi, hci⟩ := mem_natAP.mp (heq ▸ hc) refine ⟨d, hd, ⟨(i, S.card - 1 - i), by omega⟩, ?_⟩ change S.image (fun x : ℕ => (x : ℤ)) = _ have hcast := congrArg (fun T : Finset ℕ => T.image (fun x : ℕ => (x : ℤ))) heq exact hcast.trans (by simpa only [hci] using natAP_cast_eq_affine_interval a d S.card i hi) theorem exists_centered_model_bounded {N : ℕ} {S : Finset ℕ} {l : ℕ∞} {c : ℕ} (hsub : S ⊆ Finset.Icc 1 N) (hAP : (S : Set ℕ).IsAPOfLength l) (hcard : 4 ≤ S.card) (hc : c ∈ S) : ∃ d : ℕ, 0 < d ∧ d ≤ N ∧ ∃ p : ProgressionCell, IsCenteredModel c d p S := by obtain ⟨a, d, hd, heq⟩ := nat_ap_eq_natAP hAP (by omega) have hstep : a + d ∈ S := by rw [heq] exact mem_natAP.mpr ⟨1, by omega, by simp⟩ have hdN : d ≤ N := by have hh := (Finset.mem_Icc.mp (hsub hstep)).2; omega obtain ⟨i, hi, hci⟩ := mem_natAP.mp (heq ▸ hc) refine ⟨d, hd, hdN, ⟨(i, S.card - 1 - i), by omega⟩, ?_⟩ change S.image (fun x : ℕ => (x : ℤ)) = _ have hcast := congrArg (fun T : Finset ℕ => T.image (fun x : ℕ => (x : ℤ))) heq exact hcast.trans (by simpa only [hci] using natAP_cast_eq_affine_interval a d S.card i hi) theorem centered_model_determines_set {c d : ℕ} {p : ProgressionCell} {S T : Finset ℕ} (hS : IsCenteredModel c d p S) (hT : IsCenteredModel c d p T) : S = T := by have heq : S.image (fun x : ℕ => (x : ℤ)) = T.image (fun x : ℕ => (x : ℤ)) := hS.trans hT.symm exact (Finset.image_injective (f := fun x : ℕ => (x : ℤ)) Nat.cast_injective) heq end section open Finset def liftPair (c d : ℕ) (q : ℤ × ℤ) : ℕ × ℕ := (((c : ℤ) + (d : ℤ) * q.1).toNat, ((c : ℤ) + (d : ℤ) * q.2).toNat) theorem centered_point_mem {c d : ℕ} {p : ProgressionCell} {S : Finset ℕ} (hmodel : IsCenteredModel c d p S) {z : ℤ} (hz : z ∈ Finset.Icc (-(p.val.1 : ℤ)) (p.val.2 : ℤ)) : ((c : ℤ) + (d : ℤ) * z).toNat ∈ S ∧ (((c : ℤ) + (d : ℤ) * z).toNat : ℤ) = (c : ℤ) + (d : ℤ) * z := by have himage : (c : ℤ) + (d : ℤ) * z ∈ S.image (fun x : ℕ => (x : ℤ)) := by rw [hmodel] exact Finset.mem_image.mpr ⟨z, hz, rfl⟩ obtain ⟨x, hx, heq⟩ := Finset.mem_image.mp himage constructor · simpa only [← heq, Int.toNat_natCast] using hx · simp only [← heq, Int.toNat_natCast] theorem primitive_pair_coordinates {p : ProgressionCell} {q : ℤ × ℤ} (h : PrimitiveBadPair p q) : q.1 ∈ Finset.Icc (-(p.val.1 : ℤ)) (p.val.2 : ℤ) ∧ q.2 ∈ Finset.Icc (-(p.val.1 : ℤ)) (p.val.2 : ℤ) := by exact ⟨Finset.mem_Icc.mpr ⟨h.1, h.2.1.le.trans h.2.2.1⟩, Finset.mem_Icc.mpr ⟨h.1.trans h.2.1.le, h.2.2.1⟩⟩ theorem scaled_primitive_triple_not_isAP {p : ProgressionCell} {q : ℤ × ℤ} (h : PrimitiveBadPair p q) {d : ℤ} (hd : d ≠ 0) : ¬ ∃ l : ℕ∞, (({0, d * q.1, d * q.2} : Finset ℤ) : Set ℤ).IsAPOfLength l := by rcases h with ⟨hleft, hlt, hright, hu, hv, hcop, hadd, hdu, hdv⟩ apply not_isAP_triple_of_relations (mul_ne_zero hd hu) (mul_ne_zero hd hv) (fun heq => hlt.ne (mul_left_cancel₀ hd heq)) · rw [← mul_add] exact mul_ne_zero hd hadd · intro heq apply hdu apply mul_left_cancel₀ hd calc d * (2 * q.1) = 2 * (d * q.1) := by ring _ = d * q.2 := heq · intro heq apply hdv apply mul_left_cancel₀ hd calc d * q.1 = 2 * (d * q.2) := heq _ = d * (2 * q.2) := by ring def NaturalMatchedPair (c d : ℕ) (S : Finset ℕ) (q : ℕ × ℕ) : Prop := q.1 ∈ S ∧ q.2 ∈ S ∧ q.1 < q.2 ∧ q.1 ≠ c ∧ q.2 ≠ c ∧ Int.gcd ((q.1 : ℤ) - (c : ℤ)) ((q.2 : ℤ) - (c : ℤ)) = d ∧ ¬ ∃ l : ℕ∞, (({c, q.1, q.2} : Finset ℕ) : Set ℕ).IsAPOfLength l theorem liftPair_spec {c d : ℕ} {S : Finset ℕ} {p : ProgressionCell} {q : ℤ × ℤ} (hd : 0 < d) (hmodel : IsCenteredModel c d p S) (hpair : PrimitiveBadPair p q) : NaturalMatchedPair c d S (liftPair c d q) := by have hcoords := primitive_pair_coordinates hpair obtain ⟨hxS, hxcast⟩ := centered_point_mem hmodel hcoords.1 obtain ⟨hyS, hycast⟩ := centered_point_mem hmodel hcoords.2 have hdI : (0 : ℤ) < d := by exact_mod_cast hd have hdi : (d : ℤ) ≠ 0 := hdI.ne' rcases hpair with ⟨hleft, hlt, hright, hu, hv, hcop, hadd, hdu, hdv⟩ have hxy : ((c : ℤ) + (d : ℤ) * q.1).toNat < ((c : ℤ) + (d : ℤ) * q.2).toNat := by have hmul := mul_lt_mul_of_pos_left hlt hdI omega have hxc : ((c : ℤ) + (d : ℤ) * q.1).toNat ≠ c := by intro heq have hzero : (d : ℤ) * q.1 = 0 := by omega exact hu ((mul_eq_zero.mp hzero).resolve_left hdi) have hyc : ((c : ℤ) + (d : ℤ) * q.2).toNat ≠ c := by intro heq have hzero : (d : ℤ) * q.2 = 0 := by omega exact hv ((mul_eq_zero.mp hzero).resolve_left hdi) have hdiffx : (((c : ℤ) + (d : ℤ) * q.1).toNat : ℤ) - (c : ℤ) = (d : ℤ) * q.1 := by omega have hdiffy : (((c : ℤ) + (d : ℤ) * q.2).toNat : ℤ) - (c : ℤ) = (d : ℤ) * q.2 := by omega refine ⟨hxS, hyS, hxy, hxc, hyc, ?_, ?_⟩ · dsimp only [liftPair] rw [hdiffx, hdiffy, Int.gcd_mul_left, Int.natAbs_natCast, Int.gcd_def] have hg : q.1.natAbs.gcd q.2.natAbs = 1 := hcop rw [hg, Nat.mul_one] · rintro ⟨l, hAP⟩ have hcast := nat_ap_cast_int hAP have hshift := int_ap_affine_image (c := -(c : ℤ)) (d := 1) (by decide) hcast have hscaled : (({0, (d : ℤ) * q.1, (d : ℤ) * q.2} : Finset ℤ) : Set ℤ).IsAPOfLength l := by simpa [liftPair, hxcast, hycast] using hshift exact scaled_primitive_triple_not_isAP ⟨hleft, hlt, hright, hu, hv, hcop, hadd, hdu, hdv⟩ hdi ⟨l, hscaled⟩ theorem liftPair_injective_on_models {c d : ℕ} {S T : Finset ℕ} {p p' : ProgressionCell} {q q' : ℤ × ℤ} (hd : 0 < d) (hS : IsCenteredModel c d p S) (hT : IsCenteredModel c d p' T) (hq : PrimitiveBadPair p q) (hq' : PrimitiveBadPair p' q') (heq : liftPair c d q = liftPair c d q') : q = q' := by have hcs := primitive_pair_coordinates hq have hct := primitive_pair_coordinates hq' have hx := (centered_point_mem hS hcs.1).2 have hy := (centered_point_mem hS hcs.2).2 have hx' := (centered_point_mem hT hct.1).2 have hy' := (centered_point_mem hT hct.2).2 have hfst := congrArg (fun r : ℕ × ℕ => (r.1 : ℤ)) heq have hsnd := congrArg (fun r : ℕ × ℕ => (r.2 : ℤ)) heq change (((c : ℤ) + (d : ℤ) * q.1).toNat : ℤ) = (((c : ℤ) + (d : ℤ) * q'.1).toNat : ℤ) at hfst change (((c : ℤ) + (d : ℤ) * q.2).toNat : ℤ) = (((c : ℤ) + (d : ℤ) * q'.2).toNat : ℤ) at hsnd rw [hx, hx'] at hfst rw [hy, hy'] at hsnd have hdI : (d : ℤ) ≠ 0 := by exact_mod_cast hd.ne' exact Prod.ext (mul_left_cancel₀ hdI (add_left_cancel hfst)) (mul_left_cancel₀ hdI (add_left_cancel hsnd)) end section open Finset theorem exists_natural_progression_pair_matching {N c : ℕ} {F : Finset (Finset ℕ)} (hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hcard : ∀ S ∈ F, 4 ≤ S.card) (hcenter : ∀ S ∈ F, c ∈ S) : ∃ f : {S // S ∈ F} → Option (ℕ × ℕ), (∀ S q, f S = some q → ∃ d : ℕ, 0 < d ∧ d ≤ N ∧ NaturalMatchedPair c d S.val q) ∧ (∀ S T q, f S = some q → f T = some q → S = T) ∧ ((Finset.univ.filter (fun S => f S = none)).card ≤ 20000 * N) := by classical let A := {S : Finset ℕ // S ∈ F} have hparam : ∀ S : A, ∃ d : ℕ, 0 < d ∧ d ≤ N ∧ ∃ p : ProgressionCell, IsCenteredModel c d p S.val := by intro S obtain ⟨l, hAPs⟩ := hAP S.val S.property exact exists_centered_model_bounded (hsub S.val S.property) hAPs (hcard S.val S.property) (hcenter S.val S.property) choose d hd hdN p hmodel using hparam obtain ⟨f, hreal, hrealinj, hexcept⟩ := exists_progression_pair_matching let g : A → Option (ℕ × ℕ) := fun S => (f (p S)).map (liftPair c (d S)) have hvalid : ∀ S q, g S = some q → NaturalMatchedPair c (d S) S.val q := by intro S q hq obtain ⟨r, hr, hrq⟩ := Option.map_eq_some_iff.mp hq rw [← hrq] exact liftPair_spec (hd S) (hmodel S) (hreal (p S) r hr) refine ⟨g, ?_, ?_, ?_⟩ · intro S q hq exact ⟨d S, hd S, hdN S, hvalid S q hq⟩ · intro S T q hSq hTq have hSvalid := hvalid S q hSq have hTvalid := hvalid T q hTq have hdST : d S = d T := hSvalid.2.2.2.2.2.1.symm.trans hTvalid.2.2.2.2.2.1 obtain ⟨r, hr, hrq⟩ := Option.map_eq_some_iff.mp hSq obtain ⟨r', hr', hr'q⟩ := Option.map_eq_some_iff.mp hTq have hlifts : liftPair c (d T) r = liftPair c (d T) r' := by simpa only [hdST] using hrq.trans hr'q.symm have hrr' : r = r' := liftPair_injective_on_models (hd T) (by simpa only [hdST] using hmodel S) (hmodel T) (hreal (p S) r hr) (hreal (p T) r' hr') hlifts have hpST : p S = p T := hrealinj (p S) (p T) r hr (by simpa only [hrr'] using hr') apply Subtype.ext exact centered_model_determines_set (by simpa only [hdST, hpST] using hmodel S) (hmodel T) · let B : Finset A := Finset.univ.filter (fun S => g S = none) have hmaps : Set.MapsTo d (B : Set A) (Finset.Icc 1 N : Set ℕ) := by intro S hS exact Finset.mem_Icc.mpr ⟨hd S, hdN S⟩ have hfiber : ∀ k ∈ Finset.Icc 1 N, (B.filter (fun S => d S = k)).card ≤ 20000 := by intro k hk let C := B.filter (fun S => d S = k) have hpinj : Set.InjOn p (C : Set A) := by intro S hS T hT hpST have hdSk : d S = k := (Finset.mem_filter.mp hS).2 have hdTk : d T = k := (Finset.mem_filter.mp hT).2 apply Subtype.ext exact centered_model_determines_set (by simpa only [hdSk] using hmodel S) (by simpa only [hdTk, ← hpST] using hmodel T) have hfilter : (C.image p).filter (fun q => f q = none) = C.image p := by apply Finset.filter_eq_self.mpr intro q hq obtain ⟨S, hS, rfl⟩ := Finset.mem_image.mp hq have hSB : S ∈ B := (Finset.mem_filter.mp hS).1 have hnone : g S = none := (Finset.mem_filter.mp hSB).2 exact Option.map_eq_none_iff.mp hnone have hh := hexcept (C.image p) rw [hfilter, Finset.card_image_of_injOn hpinj] at hh exact hh change B.card ≤ 20000 * N rw [Finset.card_eq_sum_card_fiberwise hmaps] calc _ ≤ ∑ k ∈ Finset.Icc 1 N, 20000 := Finset.sum_le_sum hfiber _ = 20000 * N := by simp [Nat.mul_comm] end section open Finset def HasAPCover (S T : Finset ℕ) : Prop := ∃ A : Finset ℕ, A ⊆ S ∧ (∃ l : ℕ∞, (A : Set ℕ).IsAPOfLength l) ∧ T ⊆ A def IsWitnessPair (S : Finset ℕ) (c : ℕ) (P : Finset ℕ) : Prop := P.card = 2 ∧ P ⊆ S.erase c ∧ ¬ HasAPCover S (insert c P) theorem ConsecutiveIn.subset {S T : Finset ℕ} {u v : ℕ} (h : ConsecutiveIn S u v) (hTS : T ⊆ S) (hu : u ∈ T) (hv : v ∈ T) : ConsecutiveIn T u v := ⟨hu, hv, h.2.2.1, fun x hx => h.2.2.2 x (hTS hx)⟩ /-- An adjacent pair has a third point which no contained progression can cover. -/ theorem consecutive_has_missing_cover {S : Finset ℕ} {u v : ℕ} (hcrooked : IsCrooked S) (hcon : ConsecutiveIn S u v) : ∃ b ∈ S, b ≠ u ∧ b ≠ v ∧ ¬ HasAPCover S {u, v, b} := by classical let D : Finset (Finset ℕ) := S.powerset.filter (fun T : Finset ℕ => (∃ l : ℕ∞, (T : Set ℕ).IsAPOfLength l) ∧ u ∈ T ∧ v ∈ T) let U : Finset ℕ := D.biUnion id have hpairS : {u, v} ⊆ S := by simp [Finset.insert_subset_iff, hcon.1, hcon.2.1] have hpairAP : (({u, v} : Finset ℕ) : Set ℕ).IsAPOfLength 2 := by simpa using Nat.isAPOfLength_pair hcon.2.2.1 have hpairD : {u, v} ∈ D := Finset.mem_filter.mpr ⟨Finset.mem_powerset.mpr hpairS, ⟨2, hpairAP⟩, by simp, by simp⟩ have huU : u ∈ U := Finset.mem_biUnion.mpr ⟨{u, v}, hpairD, by simp⟩ have hvU : v ∈ U := Finset.mem_biUnion.mpr ⟨{u, v}, hpairD, by simp⟩ have hUclass : FixedGapAP u v U := union_closed_biUnion (fixedGapAP_empty u v) (fun S T hS hT => fixedGapAP_union hS hT) D id (by intro T hT obtain ⟨hTS, hAP, huT, hvT⟩ := Finset.mem_filter.mp hT exact Or.inr ⟨hAP, hcon.subset (Finset.mem_powerset.mp hTS) huT hvT⟩) have hUAP : ∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l := by rcases hUclass with heq | h · simp [heq] at huU · exact h.1 have hUsub : U ⊆ S := by intro x hx obtain ⟨T, hT, hxT⟩ := Finset.mem_biUnion.mp hx exact Finset.mem_powerset.mp (Finset.mem_filter.mp hT).1 hxT have hnotSub : ¬ S ⊆ U := by intro hSU have heq : S = U := Finset.Subset.antisymm hSU hUsub exact hcrooked (heq.symm ▸ hUAP) obtain ⟨b, hbS, hbU⟩ := Finset.not_subset.mp hnotSub refine ⟨b, hbS, ?_, ?_, ?_⟩ · intro heq subst b exact hbU huU · intro heq subst b exact hbU hvU · rintro ⟨T, hTS, hAP, hcover⟩ have hTD : T ∈ D := Finset.mem_filter.mpr ⟨Finset.mem_powerset.mpr hTS, hAP, hcover (by simp), hcover (by simp)⟩ exact hbU (Finset.mem_biUnion.mpr ⟨T, hTD, hcover (by simp)⟩) theorem exists_consecutive_at_mem {S : Finset ℕ} {c : ℕ} (hc : c ∈ S) (hcard : 2 ≤ S.card) : ∃ a, ConsecutiveIn S a c ∨ ConsecutiveIn S c a := by classical have herase : (S.erase c).Nonempty := by apply Finset.card_pos.mp rw [Finset.card_erase_of_mem hc] omega obtain ⟨a, ha⟩ := herase obtain ⟨hac, haS⟩ := Finset.mem_erase.mp ha rcases lt_or_gt_of_ne hac with hac | hca · let B := S.filter (fun x => x < c) have haB : a ∈ B := Finset.mem_filter.mpr ⟨haS, hac⟩ have hB : B.Nonempty := ⟨a, haB⟩ let b := B.max' hB have hbB : b ∈ B := Finset.max'_mem B hB obtain ⟨hbS, hbc⟩ := Finset.mem_filter.mp hbB refine ⟨b, Or.inl ⟨hbS, hc, hbc, ?_⟩⟩ intro x hx hbetween have hxB : x ∈ B := Finset.mem_filter.mpr ⟨hx, hbetween.2⟩ have hxb : x ≤ b := Finset.le_max' B x hxB omega · let B := S.filter (fun x => c < x) have haB : a ∈ B := Finset.mem_filter.mpr ⟨haS, hca⟩ have hB : B.Nonempty := ⟨a, haB⟩ let b := B.min' hB have hbB : b ∈ B := Finset.min'_mem B hB obtain ⟨hbS, hcb⟩ := Finset.mem_filter.mp hbB refine ⟨b, Or.inr ⟨hc, hbS, hcb, ?_⟩⟩ intro x hx hbetween have hxB : x ∈ B := Finset.mem_filter.mpr ⟨hx, hbetween.1⟩ have hbx : b ≤ x := Finset.min'_le B x hxB omega theorem crooked_card_ge_two {S : Finset ℕ} {c : ℕ} (hcrooked : IsCrooked S) (hc : c ∈ S) : 2 ≤ S.card := by by_contra hcard have hsmall : S.card ≤ 1 := by omega have heq : S = {c} := by ext x simp only [Finset.mem_singleton] exact ⟨fun hx => Finset.card_le_one.mp hsmall x hx c hc, fun hxc => hxc.symm ▸ hc⟩ apply hcrooked refine ⟨1, Set.IsAPOfLength.one.mpr ⟨c, ?_⟩⟩ simp [heq] theorem witness_pair_of_right_neighbor {S : Finset ℕ} {c a : ℕ} (hcrooked : IsCrooked S) (hcon : ConsecutiveIn S c a) : ∃ b, IsWitnessPair S c {a, b} := by obtain ⟨b, hbS, hbc, hba, hcover⟩ := consecutive_has_missing_cover hcrooked hcon refine ⟨b, ?_⟩ refine ⟨by simp [hba.symm], ?_, hcover⟩ intro x hx simp only [Finset.mem_insert, Finset.mem_singleton] at hx rcases hx with rfl | rfl · exact Finset.mem_erase.mpr ⟨hcon.2.2.1.ne', hcon.2.1⟩ · exact Finset.mem_erase.mpr ⟨hbc, hbS⟩ theorem witness_pair_of_left_neighbor {S : Finset ℕ} {c a : ℕ} (hcrooked : IsCrooked S) (hcon : ConsecutiveIn S a c) : ∃ b, IsWitnessPair S c {a, b} := by obtain ⟨b, hbS, hba, hbc, hcover⟩ := consecutive_has_missing_cover hcrooked hcon refine ⟨b, ?_⟩ have hperm : ({a, c, b} : Finset ℕ) = insert c {a, b} := by ext x simp [or_left_comm] refine ⟨by simp [hba.symm], ?_, by simpa only [hperm] using hcover⟩ intro x hx simp only [Finset.mem_insert, Finset.mem_singleton] at hx rcases hx with rfl | rfl · exact Finset.mem_erase.mpr ⟨hcon.2.2.1.ne, hcon.1⟩ · exact Finset.mem_erase.mpr ⟨hbc, hbS⟩ theorem exists_witness_pair {S : Finset ℕ} {c : ℕ} (hcrooked : IsCrooked S) (hc : c ∈ S) : ∃ P : Finset ℕ, IsWitnessPair S c P := by obtain ⟨a, hcon | hcon⟩ := exists_consecutive_at_mem hc (crooked_card_ge_two hcrooked hc) · obtain ⟨b, hb⟩ := witness_pair_of_left_neighbor hcrooked hcon exact ⟨{a, b}, hb⟩ · obtain ⟨b, hb⟩ := witness_pair_of_right_neighbor hcrooked hcon exact ⟨{a, b}, hb⟩ theorem witness_pair_private {N c : ℕ} {F : Finset (Finset ℕ)} {S T P : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hS : S ∈ F) (hT : T ∈ F) (hcS : c ∈ S) (hcT : c ∈ T) (hW : IsWitnessPair S c P) (hPT : P ⊆ T) : T = S := by by_contra hne obtain ⟨l, hl, hAP⟩ := hF.2 hS hT (fun hST => hne hST.symm) apply hW.2.2 refine ⟨S ∩ T, Finset.inter_subset_left, ⟨l, hAP⟩, ?_⟩ apply Finset.insert_subset · exact Finset.mem_inter.mpr ⟨hcS, hcT⟩ · intro x hx exact Finset.mem_inter.mpr ⟨Finset.mem_of_mem_erase (hW.2.1 hx), hPT hx⟩ theorem witness_pair_not_isAP {c : ℕ} {S P : Finset ℕ} (hc : c ∈ S) (hW : IsWitnessPair S c P) : ¬ ∃ l : ℕ∞, ((insert c P : Finset ℕ) : Set ℕ).IsAPOfLength l := by intro hAP apply hW.2.2 refine ⟨insert c P, ?_, hAP, Finset.Subset.refl _⟩ exact Finset.insert_subset hc (hW.2.1.trans (Finset.erase_subset _ _)) end section open Finset theorem sorted_pair_finset_injective {a b x y : ℕ} (hab : a < b) (hxy : x < y) (heq : ({a, b} : Finset ℕ) = {x, y}) : (a, b) = (x, y) := by have ha' : a ∈ ({x, y} : Finset ℕ) := by rw [← heq]; simp have hb' : b ∈ ({x, y} : Finset ℕ) := by rw [← heq]; simp have ha : a = x ∨ a = y := by simpa only [Finset.mem_insert, Finset.mem_singleton] using ha' have hb : b = x ∨ b = y := by simpa only [Finset.mem_insert, Finset.mem_singleton] using hb' have hax : a = x := by omega have hby : b = y := by omega exact Prod.ext hax hby theorem small_common_point_card_le {α : Type*} [DecidableEq α] {F : Finset (Finset α)} {U : Finset α} {c : α} (hsub : ∀ S ∈ F, S ⊆ U) (hc : ∀ S ∈ F, c ∈ S) (hsmall : ∀ S ∈ F, S.card ≤ 2) : F.card ≤ U.card := by have hcover : F ⊆ U.image (fun x => {c, x}) := by intro S hS have hcS := hc S hS have hcard : (S.erase c).card ≤ 1 := by rw [Finset.card_erase_of_mem hcS] have hh := hsmall S hS omega rcases (S.erase c).eq_empty_or_nonempty with hempty | hne · have hSsing : S = {c} := by rw [← Finset.insert_erase hcS, hempty] rfl refine Finset.mem_image.mpr ⟨c, hsub S hS hcS, ?_⟩ simp [hSsing] · have hone : (S.erase c).card = 1 := by have hh := Finset.card_pos.mpr hne omega obtain ⟨x, hx⟩ := Finset.card_eq_one.mp hone have hxerase : x ∈ S.erase c := by rw [hx]; simp have hxS : x ∈ S := (Finset.mem_erase.mp hxerase).2 refine Finset.mem_image.mpr ⟨x, hsub S hS hxS, ?_⟩ rw [← Finset.insert_erase hcS, hx] exact (Finset.card_le_card hcover).trans (Finset.card_image_le) theorem partial_matching_card_le {α β : Type*} [Fintype α] [DecidableEq β] [Inhabited β] {B : Finset β} {M : ℕ} (f : α → Option β) (hvalid : ∀ a b, f a = some b → b ∈ B) (hinj : ∀ a a' b, f a = some b → f a' = some b → a = a') (hmiss : (Finset.univ.filter (fun a => f a = none)).card ≤ M) : Fintype.card α ≤ B.card + M := by classical let R : Finset α := Finset.univ.filter (fun a => f a ≠ none) let g : α → β := fun a => (f a).getD default have hsome : ∀ a ∈ R, f a = some (g a) := by intro a ha obtain ⟨b, hb⟩ := Option.ne_none_iff_exists'.mp (Finset.mem_filter.mp ha).2 simp [g, hb] have hRcard : R.card ≤ B.card := Finset.card_le_card_of_injOn g (fun a ha => hvalid a (g a) (hsome a ha)) (by intro a ha a' ha' heq exact hinj a a' (g a) (hsome a ha) (by simpa only [heq] using hsome a' ha')) have hpartition := Finset.card_filter_add_card_filter_not (s := (Finset.univ : Finset α)) (fun a => f a = none) simp only [Finset.card_univ] at hpartition change (Finset.univ.filter (fun a => f a = none)).card + R.card = Fintype.card α at hpartition omega theorem extend_partial_matching {α β : Type*} [DecidableEq α] {Q : Finset α} {P : α → β → Prop} {M : ℕ} (f : {a // a ∈ Q} → Option β) (hvalid : ∀ a b, f a = some b → P a.val b) (hinj : ∀ a a' b, f a = some b → f a' = some b → a = a') (hmiss : (Finset.univ.filter (fun a => f a = none)).card ≤ M) : ∃ g : α → Option β, (∀ a b, g a = some b → P a b) ∧ (∀ a a' b, g a = some b → g a' = some b → a = a') ∧ (∀ S : Finset α, S ⊆ Q → (S.filter (fun a => g a = none)).card ≤ M) := by classical let g : α → Option β := fun a => if h : a ∈ Q then f ⟨a, h⟩ else none have hsome {a : α} {b : β} (h : g a = some b) : ∃ ha : a ∈ Q, f ⟨a, ha⟩ = some b := by by_cases ha : a ∈ Q · exact ⟨ha, by simpa only [g, dif_pos ha] using h⟩ · simp [g, ha] at h refine ⟨g, ?_, ?_, ?_⟩ · intro a b hab obtain ⟨ha, hf⟩ := hsome hab exact hvalid ⟨a, ha⟩ b hf · intro a a' b hab ha'b obtain ⟨ha, hf⟩ := hsome hab obtain ⟨ha', hf'⟩ := hsome ha'b exact congrArg (fun x : {a // a ∈ Q} => x.val) (hinj ⟨a, ha⟩ ⟨a', ha'⟩ b hf hf') · intro S hSQ let E := S.filter (fun a => g a = none) let e : {a // a ∈ E} → {a // a ∈ Q} := fun a => ⟨a.val, hSQ (Finset.mem_filter.mp a.property).1⟩ have heinj : Function.Injective e := by intro a a' heq exact Subtype.ext (congrArg (fun x : {a // a ∈ Q} => x.val) heq) have hemaps : Set.MapsTo e ((Finset.univ : Finset {a // a ∈ E}) : Set {a // a ∈ E}) ((Finset.univ.filter (fun a => f a = none)) : Set {a // a ∈ Q}) := by intro a ha have haQ : a.val ∈ Q := hSQ (Finset.mem_filter.mp a.property).1 have hh : g a.val = none := (Finset.mem_filter.mp a.property).2 exact Finset.mem_filter.mpr ⟨Finset.mem_univ _, by simpa only [g, dif_pos haQ, e] using hh⟩ have hEcard := Finset.card_le_card_of_injOn e hemaps heinj.injOn simpa only [Finset.card_univ, Fintype.card_coe] using hEcard.trans hmiss end section open Finset theorem exists_common_point_pair_matching_allowed {N c : ℕ} {F : Finset (Finset ℕ)} {Allowed : Finset ℕ → Prop} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hcard : ∀ S ∈ F, 3 ≤ S.card) (hWitness : ∀ S ∈ F, IsCrooked S → ∃ P, IsWitnessPair S c P ∧ Allowed P) (hTriple : ∀ S ∈ F, S.card = 3 → Allowed (S.erase c)) (hMatch : ∀ G : Finset (Finset ℕ), G ⊆ F → (∀ S ∈ G, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) → (∀ S ∈ G, 4 ≤ S.card) → ∃ g : {S // S ∈ G} → Option (ℕ × ℕ), (∀ S q, g S = some q → ∃ d : ℕ, 0 < d ∧ d ≤ N ∧ NaturalMatchedPair c d S.val q ∧ Allowed {q.1, q.2}) ∧ (∀ S T q, g S = some q → g T = some q → S = T) ∧ (Finset.univ.filter (fun S => g S = none)).card ≤ 20000 * N) : ∃ f : {S // S ∈ F} → Option (Finset ℕ), (∀ S P, f S = some P → P.card = 2 ∧ P ⊆ S.val.erase c) ∧ (∀ S P, f S = some P → Allowed P) ∧ (∀ S T P, f S = some P → f T = some P → S = T) ∧ (Finset.univ.filter (fun S => f S = none)).card ≤ 20000 * N := by classical let A := {S : Finset ℕ // S ∈ F} let L := F.filter (fun S => ¬ IsCrooked S ∧ 4 ≤ S.card) obtain ⟨g, hgvalid, hginj, hgmiss⟩ := hMatch L (Finset.filter_subset _ _) (fun S hS => of_not_not (Finset.mem_filter.mp hS).2.1) (fun S hS => (Finset.mem_filter.mp hS).2.2) let large (S : A) (hn : ¬ IsCrooked S.val) (ht : S.val.card ≠ 3) : {T // T ∈ L} := ⟨S.val, Finset.mem_filter.mpr ⟨S.property, hn, by have hh := hcard S.val S.property; omega⟩⟩ let w (S : A) (h : IsCrooked S.val) : Finset ℕ := Classical.choose (hWitness S.val S.property h) have hw (S : A) (h : IsCrooked S.val) : IsWitnessPair S.val c (w S h) ∧ Allowed (w S h) := Classical.choose_spec (hWitness S.val S.property h) let f : A → Option (Finset ℕ) := fun S => if h : IsCrooked S.val then some (w S h) else if ht : S.val.card = 3 then some (S.val.erase c) else (g (large S h ht)).map (fun q => {q.1, q.2}) have hcrook (S : A) {P : Finset ℕ} (hP : f S = some P) (h : IsCrooked S.val) : IsWitnessPair S.val c P := by have heq : w S h = P := by simpa only [f, dif_pos h, Option.some.injEq] using hP exact heq ▸ (hw S h).1 have hthree (S : A) {P : Finset ℕ} (hP : f S = some P) (hn : ¬ IsCrooked S.val) (ht : S.val.card = 3) : P = S.val.erase c := by have heq : S.val.erase c = P := by simpa only [f, dif_neg hn, dif_pos ht, Option.some.injEq] using hP exact heq.symm have hlarge (S : A) {P : Finset ℕ} (hP : f S = some P) (hn : ¬ IsCrooked S.val) (ht : S.val.card ≠ 3) : ∃ r : ℕ × ℕ, g (large S hn ht) = some r ∧ P = {r.1, r.2} ∧ ∃ d : ℕ, NaturalMatchedPair c d S.val r := by have hm : (g (large S hn ht)).map (fun q => ({q.1, q.2} : Finset ℕ)) = some P := by simpa only [f, dif_neg hn, dif_neg ht] using hP obtain ⟨r, hr, hrP⟩ := Option.map_eq_some_iff.mp hm obtain ⟨d, hd, hdN, hnat, hAllowed⟩ := hgvalid (large S hn ht) r hr exact ⟨r, hr, hrP.symm, d, hnat⟩ have hvalid (S : A) (P : Finset ℕ) (hP : f S = some P) : P.card = 2 ∧ P ⊆ S.val.erase c := by by_cases hn : IsCrooked S.val · exact ⟨(hcrook S hP hn).1, (hcrook S hP hn).2.1⟩ by_cases ht : S.val.card = 3 · rw [hthree S hP hn ht] exact ⟨by rw [Finset.card_erase_of_mem (hc S.val S.property), ht], Finset.Subset.refl _⟩ obtain ⟨r, hr, rfl, d, hnat⟩ := hlarge S hP hn ht refine ⟨by simp [hnat.2.2.1.ne], ?_⟩ intro x hx simp only [Finset.mem_insert, Finset.mem_singleton] at hx rcases hx with rfl | rfl · exact Finset.mem_erase.mpr ⟨hnat.2.2.2.1, hnat.1⟩ · exact Finset.mem_erase.mpr ⟨hnat.2.2.2.2.1, hnat.2.1⟩ have hallowed (S : A) (P : Finset ℕ) (hP : f S = some P) : Allowed P := by by_cases hn : IsCrooked S.val · have heq : w S hn = P := by simpa only [f, dif_pos hn, Option.some.injEq] using hP exact heq ▸ (hw S hn).2 by_cases ht : S.val.card = 3 · rw [hthree S hP hn ht] exact hTriple S.val S.property ht obtain ⟨r, hr, hrP, d, hnat⟩ := hlarge S hP hn ht obtain ⟨e, he, heN, hnat', hAllowed⟩ := hgvalid (large S hn ht) r hr exact hrP.symm ▸ hAllowed refine ⟨f, hvalid, hallowed, ?_, ?_⟩ · intro S T P hS hT by_cases hSc : IsCrooked S.val · apply Subtype.ext exact (witness_pair_private hF S.property T.property (hc S.val S.property) (hc T.val T.property) (hcrook S hS hSc) ((hvalid T P hT).2.trans (Finset.erase_subset _ _))).symm by_cases hTc : IsCrooked T.val · apply Subtype.ext exact witness_pair_private hF T.property S.property (hc T.val T.property) (hc S.val S.property) (hcrook T hT hTc) ((hvalid S P hS).2.trans (Finset.erase_subset _ _)) have hS_AP : ∃ l : ℕ∞, (S.val : Set ℕ).IsAPOfLength l := of_not_not hSc have hT_AP : ∃ l : ℕ∞, (T.val : Set ℕ).IsAPOfLength l := of_not_not hTc by_cases hS3 : S.val.card = 3 · have hSP : S.val = insert c P := by rw [hthree S hS hSc hS3, Finset.insert_erase (hc S.val S.property)] by_cases hT3 : T.val.card = 3 · apply Subtype.ext rw [hSP, hthree T hT hTc hT3, Finset.insert_erase (hc T.val T.property)] · obtain ⟨r, hr, hrP, d, hnat⟩ := hlarge T hT hTc hT3 exact False.elim (hnat.2.2.2.2.2.2 (by simpa only [hSP, hrP] using hS_AP)) · by_cases hT3 : T.val.card = 3 · have hTP : T.val = insert c P := by rw [hthree T hT hTc hT3, Finset.insert_erase (hc T.val T.property)] obtain ⟨r, hr, hrP, d, hnat⟩ := hlarge S hS hSc hS3 exact False.elim (hnat.2.2.2.2.2.2 (by simpa only [hTP, hrP] using hT_AP)) · obtain ⟨r, hr, hrP, d, hnat⟩ := hlarge S hS hSc hS3 obtain ⟨s, hs, hsP, e, hnat'⟩ := hlarge T hT hTc hT3 have hrs : r = s := sorted_pair_finset_injective hnat.2.2.1 hnat'.2.2.1 (hrP.symm.trans hsP) have hST := hginj (large S hSc hS3) (large T hTc hT3) r hr (by simpa only [hrs] using hs) exact Subtype.ext (congrArg (fun U : {T // T ∈ L} => U.val) hST) · let E : Finset A := Finset.univ.filter (fun S => f S = none) have hex : ∀ S : {S // S ∈ E}, ∃ T : {T // T ∈ L}, T.val = S.val.val ∧ g T = none := by intro S have hfnone : f S.val = none := (Finset.mem_filter.mp S.property).2 by_cases hn : IsCrooked S.val.val · simp only [f, dif_pos hn, Option.some_ne_none] at hfnone by_cases ht : S.val.val.card = 3 · simp only [f, dif_neg hn, dif_pos ht, Option.some_ne_none] at hfnone refine ⟨large S.val hn ht, rfl, ?_⟩ have hm : (g (large S.val hn ht)).map (fun q => ({q.1, q.2} : Finset ℕ)) = none := by simpa only [f, dif_neg hn, dif_neg ht] using hfnone exact Option.map_eq_none_iff.mp hm choose e he henone using hex have heinj : Function.Injective e := by intro S T heq apply Subtype.ext apply Subtype.ext exact (he S).symm.trans ((congrArg Subtype.val heq).trans (he T)) have hemaps : Set.MapsTo e ((Finset.univ : Finset {S // S ∈ E}) : Set {S // S ∈ E}) ((Finset.univ.filter (fun T => g T = none)) : Set {T // T ∈ L}) := by intro S hS exact Finset.mem_filter.mpr ⟨Finset.mem_univ _, henone S⟩ have hEcard := Finset.card_le_card_of_injOn e hemaps heinj.injOn have hh := hEcard.trans hgmiss simpa only [Finset.card_univ, Fintype.card_coe] using hh theorem exists_common_point_pair_matching {N c : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hcard : ∀ S ∈ F, 3 ≤ S.card) : ∃ f : {S // S ∈ F} → Option (Finset ℕ), (∀ S P, f S = some P → P.card = 2 ∧ P ⊆ S.val.erase c) ∧ (∀ S T P, f S = some P → f T = some P → S = T) ∧ (Finset.univ.filter (fun S => f S = none)).card ≤ 20000 * N := by have hMatch : ∀ G : Finset (Finset ℕ), G ⊆ F → (∀ S ∈ G, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) → (∀ S ∈ G, 4 ≤ S.card) → ∃ g : {S // S ∈ G} → Option (ℕ × ℕ), (∀ S q, g S = some q → ∃ d : ℕ, 0 < d ∧ d ≤ N ∧ NaturalMatchedPair c d S.val q ∧ True) ∧ (∀ S T q, g S = some q → g T = some q → S = T) ∧ (Finset.univ.filter (fun S => g S = none)).card ≤ 20000 * N := by intro G hGF hAP hcard obtain ⟨g, hvalid, hinj, hmiss⟩ := exists_natural_progression_pair_matching (fun S hS => Finset.mem_powerset.mp (hF.1 (hGF hS))) hAP hcard (fun S hS => hc S (hGF hS)) refine ⟨g, ?_, hinj, hmiss⟩ intro S q hq obtain ⟨d, hd, hdN, hnat⟩ := hvalid S q hq exact ⟨d, hd, hdN, hnat, trivial⟩ obtain ⟨f, hvalid, hAllowed, hinj, hmiss⟩ := exists_common_point_pair_matching_allowed (Allowed := fun _ => True) hF hc hcard (fun S hS hcrooked => by obtain ⟨P, hP⟩ := exists_witness_pair hcrooked (hc S hS) exact ⟨P, hP, trivial⟩) (fun S hS h3 => trivial) hMatch exact ⟨f, hvalid, hinj, hmiss⟩ theorem common_point_large_card_le {N c : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hcard : ∀ S ∈ F, 3 ≤ S.card) : F.card ≤ N.choose 2 + 20000 * N := by classical obtain ⟨f, hvalid, hinj, hmiss⟩ := exists_common_point_pair_matching hF hc hcard have hm := partial_matching_card_le (B := (Finset.Icc 1 N).powersetCard 2) f (fun S P hP => Finset.mem_powersetCard.mpr ⟨(hvalid S P hP).2.trans ((Finset.erase_subset c S.val).trans (Finset.mem_powerset.mp (hF.1 S.property))), (hvalid S P hP).1⟩) hinj hmiss simpa using hm theorem common_point_card_le {N c : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) : F.card ≤ N.choose 2 + 20001 * N := by classical let B := F.filter (fun S => S.card ≤ 2) let G := F.filter (fun S => ¬ S.card ≤ 2) have hB : B.card ≤ N := by have hh := small_common_point_card_le (F := B) (U := Finset.Icc 1 N) (c := c) (fun S hS => Finset.mem_powerset.mp (hF.1 (Finset.mem_filter.mp hS).1)) (fun S hS => hc S (Finset.mem_filter.mp hS).1) (fun S hS => (Finset.mem_filter.mp hS).2) simpa using hh have hG : G.card ≤ N.choose 2 + 20000 * N := common_point_large_card_le (arithInterSet_mono hF (Finset.filter_subset _ _)) (fun S hS => hc S (Finset.mem_filter.mp hS).1) (fun S hS => by have hh := (Finset.mem_filter.mp hS).2; omega) have hpartition := Finset.card_filter_add_card_filter_not (s := F) (fun S => S.card ≤ 2) change B.card + G.card = F.card at hpartition omega theorem common_point_card_le_real {N c : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) : (F.card : ℝ) ≤ (N : ℝ)^2 / 2 + 20001 * (N : ℝ) := by have hh : (F.card : ℝ) ≤ (N.choose 2 : ℝ) + 20001 * (N : ℝ) := by exact_mod_cast common_point_card_le hF hc rw [Nat.cast_choose_two] at hh have hN : (0 : ℝ) ≤ N := Nat.cast_nonneg N nlinarith end section open Finset theorem coprime_row_tail_card {A r : ℕ} : r.totient ≤ (((Finset.Icc 1 r).filter (fun a => r.Coprime a)).filter (fun a => A ≤ a)).card + A := by let D := (Finset.Icc 1 r).filter (fun a => r.Coprime a) have hsmall : (D.filter (fun a => ¬ A ≤ a)).card ≤ A := by have hsub : D.filter (fun a => ¬ A ≤ a) ⊆ Finset.range A := by intro a ha exact Finset.mem_range.mpr (Nat.lt_of_not_ge (Finset.mem_filter.mp ha).2) simpa using Finset.card_le_card hsub have hpart := Finset.card_filter_add_card_filter_not (s := D) (fun a => A ≤ a) have hD : D.card = r.totient := card_coprime_Icc r change r.totient ≤ (D.filter (fun a => A ≤ a)).card + A omega theorem exists_axis_row_assignment {A C r : ℕ} (hr : 3 ≤ r) (hsupply : A + C + 1 ≤ r.totient) : ∃ g : Fin (C + 1) → ℕ, Function.Injective g ∧ ∀ i, (g i, r) ∈ axisPairs r ∧ A ≤ g i := by let D := ((Finset.Icc 1 r).filter (fun a => r.Coprime a)).filter (fun a => A ≤ a) have hcard : C + 1 ≤ D.card := by have hh := coprime_row_tail_card (A := A) (r := r) change r.totient ≤ D.card + A at hh omega let e : Fin (C + 1) → Fin D.card := fun i => ⟨i.val, lt_of_lt_of_le i.isLt hcard⟩ let g : Fin (C + 1) → ℕ := fun i => (D.orderEmbOfFin rfl) (e i) refine ⟨g, ?_, ?_⟩ · intro i j hij have he : e i = e j := (D.orderEmbOfFin rfl).injective hij exact Fin.ext (congrArg (fun i : Fin D.card => i.val) he) · intro i have hiD : g i ∈ D := D.orderEmbOfFin_mem rfl (e i) obtain ⟨hirow, hiA⟩ := Finset.mem_filter.mp hiD obtain ⟨hiI, hcop⟩ := Finset.mem_filter.mp hirow obtain ⟨hi1, hir⟩ := Finset.mem_Icc.mp hiI have hir' : g i < r := by by_contra hh have heq : g i = r := by omega have hone : r = 1 := by simpa only [heq, Nat.coprime_self] using hcop omega exact ⟨mem_axisPairs.mpr ⟨hi1, hir', hr, le_rfl, hcop.symm⟩, hiA⟩ theorem exists_corner_pair_matching {A B C M : ℕ} (hB : 2 ≤ B) (hsupply : ∀ r : ℕ, B < r → r ≤ M → A + C + 1 ≤ r.totient) (Q : Finset ProgressionCell) (hleft : ∀ p ∈ Q, p.val.1 ≤ C) (hright : ∀ p ∈ Q, p.val.2 ≤ M) : ∃ f : {p // p ∈ Q} → Option (ℤ × ℤ), (∀ p q, f p = some q → PrimitiveBadPair p.val q ∧ (q.2 ≤ (B : ℤ) ∨ (A : ℤ) ≤ q.1)) ∧ (∀ p p' q, f p = some q → f p' = some q → p = p') ∧ (Finset.univ.filter (fun p => f p = none)).card ≤ 20000 := by classical let R := {r : ℕ // B < r ∧ r ≤ M} have hrows : ∀ r : R, ∃ g : Fin (C + 1) → ℕ, Function.Injective g ∧ ∀ i, (g i, r.val) ∈ axisPairs r.val ∧ A ≤ g i := by intro r exact exists_axis_row_assignment (by have hh := r.property.1; omega) (hsupply r.val r.property.1 r.property.2) choose a hainj haspec using hrows obtain ⟨g, hgvalid, hginj, hgmiss⟩ := exists_progression_pair_matching let ri (p : {p // p ∈ Q}) (hr : B < p.val.val.2) : R := ⟨p.val.val.2, hr, hright p.val p.property⟩ let li (p : {p // p ∈ Q}) : Fin (C + 1) := ⟨p.val.val.1, Nat.lt_succ_of_le (hleft p.val p.property)⟩ let f : {p // p ∈ Q} → Option (ℤ × ℤ) := fun p => if hr : B < p.val.val.2 then some ((a (ri p hr) (li p) : ℤ), (p.val.val.2 : ℤ)) else g p.val have hlong (p : {p // p ∈ Q}) {q : ℤ × ℤ} (hq : f p = some q) (hr : B < p.val.val.2) : ((a (ri p hr) (li p) : ℤ), (p.val.val.2 : ℤ)) = q := by exact Option.some.inj (by simpa only [f, dif_pos hr] using hq) have hshort (p : {p // p ∈ Q}) {q : ℤ × ℤ} (hq : f p = some q) (hr : ¬ B < p.val.val.2) : g p.val = some q := by simpa only [f, dif_neg hr] using hq refine ⟨f, ?_, ?_, ?_⟩ · intro p q hq by_cases hr : B < p.val.val.2 · rw [← hlong p hq hr] exact ⟨primitiveBadPair_positive (haspec (ri p hr) (li p)).1, Or.inr (by change (A : ℤ) ≤ (a (ri p hr) (li p) : ℤ) exact_mod_cast (haspec (ri p hr) (li p)).2)⟩ · have hp := hgvalid p.val q (hshort p hq hr) exact ⟨hp, Or.inl (by have hh := hp.2.2.1; omega)⟩ · intro p p' q hp hp' by_cases hr : B < p.val.val.2 · have heq := hlong p hp hr by_cases hr' : B < p'.val.val.2 · have heq' := hlong p' hp' hr' have hrI := congrArg Prod.snd (heq.trans heq'.symm) change (p.val.val.2 : ℤ) = (p'.val.val.2 : ℤ) at hrI have hrr : p.val.val.2 = p'.val.val.2 := by exact_mod_cast hrI have hri : ri p hr = ri p' hr' := Subtype.ext hrr have hfst := congrArg Prod.fst (heq.trans heq'.symm) change (a (ri p hr) (li p) : ℤ) = (a (ri p' hr') (li p') : ℤ) at hfst rw [hri] at hfst have hl : li p = li p' := hainj (ri p' hr') (by exact_mod_cast hfst) apply Subtype.ext apply Subtype.ext exact Prod.ext (congrArg Fin.val hl) hrr · have hbound := (hgvalid p'.val q (hshort p' hp' hr')).2.2.1 have hsnd := congrArg Prod.snd heq change (p.val.val.2 : ℤ) = q.2 at hsnd omega · by_cases hr' : B < p'.val.val.2 · have hbound := (hgvalid p.val q (hshort p hp hr)).2.2.1 have hsnd := congrArg Prod.snd (hlong p' hp' hr') change (p'.val.val.2 : ℤ) = q.2 at hsnd omega · exact Subtype.ext (hginj p.val p'.val q (hshort p hp hr) (hshort p' hp' hr')) · have hmaps : Set.MapsTo (fun p : {p // p ∈ Q} => p.val) ((Finset.univ.filter (fun p => f p = none)) : Set {p // p ∈ Q}) ((Q.filter (fun p => g p = none)) : Set ProgressionCell) := by intro p hp have hnone : f p = none := (Finset.mem_filter.mp hp).2 have hr : ¬ B < p.val.val.2 := by intro hr simp only [f, dif_pos hr, Option.some_ne_none] at hnone have hg : g p.val = none := by simpa only [f, dif_neg hr] using hnone exact Finset.mem_filter.mpr ⟨p.property, hg⟩ exact (Finset.card_le_card_of_injOn (fun p : {p // p ∈ Q} => p.val) hmaps Subtype.coe_injective.injOn).trans (hgmiss Q) def boundedProgressionCells (C M : ℕ) : Finset ProgressionCell := ((Finset.range (C + 1)).product (Finset.range (M + 1))).subtype (fun p => 3 ≤ p.1 + p.2) theorem mem_boundedProgressionCells {C M : ℕ} {p : ProgressionCell} : p ∈ boundedProgressionCells C M ↔ p.val.1 ≤ C ∧ p.val.2 ≤ M := by simp [boundedProgressionCells] theorem exists_bounded_corner_matching {A B C M : ℕ} (hB : 2 ≤ B) (hsupply : ∀ r : ℕ, B < r → r ≤ M → A + C + 1 ≤ r.totient) : ∃ f : ProgressionCell → Option (ℤ × ℤ), (∀ p q, f p = some q → PrimitiveBadPair p q ∧ (q.2 ≤ (B : ℤ) ∨ (A : ℤ) ≤ q.1)) ∧ (∀ p p' q, f p = some q → f p' = some q → p = p') ∧ (∀ S : Finset ProgressionCell, S ⊆ boundedProgressionCells C M → (S.filter (fun p => f p = none)).card ≤ 20000) := by obtain ⟨f, hvalid, hinj, hmiss⟩ := exists_corner_pair_matching hB hsupply (boundedProgressionCells C M) (fun p hp => (mem_boundedProgressionCells.mp hp).1) (fun p hp => (mem_boundedProgressionCells.mp hp).2) exact extend_partial_matching f hvalid hinj hmiss end section theorem corner_totient_row_supply {N c L R d r : ℕ} (hcL : c < L) (hLR : L ≤ R) (hRN : R ≤ N) (hd : 0 < d) (hdt : d ≤ L + N - R) (hN : 256 * (L + N - R) * (Nat.log 2 N + 1) ≤ N) (hr : (R - c) / d < r) (hrN : r ≤ N / d) : ((L - c) / d + 1) + c / d + 1 ≤ r.totient := by let t := L + N - R let K := Nat.log 2 N + 1 have hLt : L ≤ t := by dsimp [t]; omega have hct : c ≤ t := hcL.le.trans hLt have htp : 0 < t := by omega have hNt : N + L = t + R := by dsimp [t]; omega have hRc : R - c + c = R := Nat.sub_add_cancel (hcL.le.trans hLR) have hLc : L - c + c = L := Nat.sub_add_cancel hcL.le have hrN' : r ≤ N := hrN.trans (Nat.div_le_self N d) have hlog : Nat.log 2 r + 1 ≤ K := Nat.add_le_add_right (Nat.log_mono_right hrN') 1 have hrphi : r ≤ K * r.totient := (le_log_succ_mul_totient r).trans (Nat.mul_le_mul_right r.totient hlog) have hRr : R - c < r * d := (Nat.div_lt_iff_lt_mul hd).mp hr by_contra hphi have hphi' : r.totient ≤ (L - c) / d + c / d + 1 := by omega have hmul : d * r.totient ≤ 2 * t := by have hdivL := Nat.mul_div_le (L - c) d have hdivc := Nat.mul_div_le c d have hh := Nat.mul_le_mul_left d hphi' nlinarith have hupper : d * r ≤ K * (2 * t) := by calc d * r ≤ d * (K * r.totient) := Nat.mul_le_mul_left d hrphi _ = K * (d * r.totient) := by ring _ ≤ K * (2 * t) := Nat.mul_le_mul_left K hmul have hK : 1 ≤ K := by dsimp [K]; omega change 256 * t * K ≤ N at hN have hprod : t ≤ t * K := by nlinarith nlinarith theorem corner_normalized_threshold {N c L R d : ℕ} (hcL : c < L) (hLR : L ≤ R) (hRN : R ≤ N) (hd : 0 < d) (hdt : d ≤ L + N - R) (hN : 256 * (L + N - R) * (Nat.log 2 N + 1) ≤ N) : 2 ≤ (R - c) / d := by apply (Nat.le_div_iff_mul_le hd).mpr have ht : L ≤ L + N - R := by omega have hc : c ≤ L + N - R := by omega have hmul : 256 * (L + N - R) ≤ 256 * (L + N - R) * (Nat.log 2 N + 1) := by exact Nat.le_mul_of_pos_right _ (by omega) omega end section open Finset theorem centered_model_cell_bounds {N c d : ℕ} {p : ProgressionCell} {S : Finset ℕ} (hd : 0 < d) (hmodel : IsCenteredModel c d p S) (hsub : S ⊆ Finset.Icc 1 N) : p.val.1 ≤ c / d ∧ p.val.2 ≤ N / d := by have hl := centered_point_mem hmodel (Finset.mem_Icc.mpr ⟨le_rfl, (by omega : -(p.val.1 : ℤ) ≤ (p.val.2 : ℤ))⟩) have hr := centered_point_mem hmodel (Finset.mem_Icc.mpr ⟨(by omega : -(p.val.1 : ℤ) ≤ (p.val.2 : ℤ)), le_rfl⟩) have hlI := Finset.mem_Icc.mp (hsub hl.1) have hrI := Finset.mem_Icc.mp (hsub hr.1) have hleftI : (p.val.1 : ℤ) * (d : ℤ) ≤ c := by nlinarith [hl.2] have hrightI : (p.val.2 : ℤ) * (d : ℤ) ≤ N := by nlinarith [hr.2] exact ⟨(Nat.le_div_iff_mul_le hd).mpr (by exact_mod_cast hleftI), (Nat.le_div_iff_mul_le hd).mpr (by exact_mod_cast hrightI)⟩ theorem exists_natural_progression_pair_matching_constrained {N c : ℕ} {F : Finset (Finset ℕ)} {P : (ℕ × ℕ) → Prop} (hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hcard : ∀ S ∈ F, 4 ≤ S.card) (hcenter : ∀ S ∈ F, c ∈ S) (hmatch : ∀ d : ℕ, 0 < d → d ≤ N → ∃ f : ProgressionCell → Option (ℤ × ℤ), (∀ p q, f p = some q → PrimitiveBadPair p q ∧ ∀ S : Finset ℕ, IsCenteredModel c d p S → P (liftPair c d q)) ∧ (∀ p p' q, f p = some q → f p' = some q → p = p') ∧ (∀ Q : Finset ProgressionCell, (∀ p ∈ Q, p.val.1 ≤ c / d ∧ p.val.2 ≤ N / d) → (Q.filter (fun p => f p = none)).card ≤ 20000)) : ∃ f : {S // S ∈ F} → Option (ℕ × ℕ), (∀ S q, f S = some q → ∃ d : ℕ, 0 < d ∧ d ≤ N ∧ NaturalMatchedPair c d S.val q ∧ P q) ∧ (∀ S T q, f S = some q → f T = some q → S = T) ∧ (Finset.univ.filter (fun S => f S = none)).card ≤ 20000 * N := by classical let A := {S : Finset ℕ // S ∈ F} let D := {k : ℕ // 0 < k ∧ k ≤ N} have hparam : ∀ S : A, ∃ d : ℕ, 0 < d ∧ d ≤ N ∧ ∃ p : ProgressionCell, IsCenteredModel c d p S.val := by intro S obtain ⟨l, hAPs⟩ := hAP S.val S.property exact exists_centered_model_bounded (hsub S.val S.property) hAPs (hcard S.val S.property) (hcenter S.val S.property) choose d hd hdN p hmodel using hparam let k : A → D := fun S => ⟨d S, hd S, hdN S⟩ choose f hfvalid hfinj hfmiss using (fun k : D => hmatch k.val k.property.1 k.property.2) let g : A → Option (ℕ × ℕ) := fun S => (f (k S) (p S)).map (liftPair c (d S)) have hvalid : ∀ S q, g S = some q → NaturalMatchedPair c (d S) S.val q ∧ P q := by intro S q hq obtain ⟨r, hr, hrq⟩ := Option.map_eq_some_iff.mp hq rw [← hrq] have hv := hfvalid (k S) (p S) r hr exact ⟨liftPair_spec (hd S) (hmodel S) hv.1, hv.2 S.val (hmodel S)⟩ refine ⟨g, ?_, ?_, ?_⟩ · intro S q hq exact ⟨d S, hd S, hdN S, hvalid S q hq⟩ · intro S T q hSq hTq have hSvalid := (hvalid S q hSq).1 have hTvalid := (hvalid T q hTq).1 have hdST : d S = d T := hSvalid.2.2.2.2.2.1.symm.trans hTvalid.2.2.2.2.2.1 have hkST : k S = k T := Subtype.ext hdST obtain ⟨r, hr, hrq⟩ := Option.map_eq_some_iff.mp hSq obtain ⟨r', hr', hr'q⟩ := Option.map_eq_some_iff.mp hTq have hlifts : liftPair c (d T) r = liftPair c (d T) r' := by simpa only [hdST] using hrq.trans hr'q.symm have hrr' : r = r' := liftPair_injective_on_models (hd T) (by simpa only [hdST] using hmodel S) (hmodel T) (hfvalid (k S) (p S) r hr).1 (hfvalid (k T) (p T) r' hr').1 hlifts have hpST : p S = p T := hfinj (k T) (p S) (p T) r (by simpa only [hkST] using hr) (by simpa only [hrr'] using hr') apply Subtype.ext exact centered_model_determines_set (by simpa only [hdST, hpST] using hmodel S) (hmodel T) · let B : Finset A := Finset.univ.filter (fun S => g S = none) have hmaps : Set.MapsTo d (B : Set A) (Finset.Icc 1 N : Set ℕ) := by intro S hS exact Finset.mem_Icc.mpr ⟨hd S, hdN S⟩ have hfiber : ∀ j ∈ Finset.Icc 1 N, (B.filter (fun S => d S = j)).card ≤ 20000 := by intro j hj let C := B.filter (fun S => d S = j) let kj : D := ⟨j, (Finset.mem_Icc.mp hj).1, (Finset.mem_Icc.mp hj).2⟩ have hdj : ∀ S ∈ C, d S = j := fun S hS => (Finset.mem_filter.mp hS).2 have hkj : ∀ S ∈ C, k S = kj := fun S hS => Subtype.ext (hdj S hS) have hpinj : Set.InjOn p (C : Set A) := by intro S hS T hT hpST apply Subtype.ext exact centered_model_determines_set (by simpa only [hdj S hS] using hmodel S) (by simpa only [hdj T hT, ← hpST] using hmodel T) have hfilter : (C.image p).filter (fun q => f kj q = none) = C.image p := by apply Finset.filter_eq_self.mpr intro q hq obtain ⟨S, hS, rfl⟩ := Finset.mem_image.mp hq have hSB : S ∈ B := (Finset.mem_filter.mp hS).1 have hnone : g S = none := (Finset.mem_filter.mp hSB).2 have hh := Option.map_eq_none_iff.mp hnone simpa only [hkj S hS] using hh have hbounds : ∀ q ∈ C.image p, q.val.1 ≤ c / kj.val ∧ q.val.2 ≤ N / kj.val := by intro q hq obtain ⟨S, hS, rfl⟩ := Finset.mem_image.mp hq have hh := centered_model_cell_bounds (hd S) (hmodel S) (hsub S.val S.property) simpa only [hdj S hS] using hh have hh := hfmiss kj (C.image p) hbounds rw [hfilter, Finset.card_image_of_injOn hpinj] at hh exact hh change B.card ≤ 20000 * N rw [Finset.card_eq_sum_card_fiberwise hmaps] calc _ ≤ ∑ j ∈ Finset.Icc 1 N, 20000 := Finset.sum_le_sum hfiber _ = 20000 * N := by simp [Nat.mul_comm] end section def AffineAvoidsCorner (c L R d : ℕ) (q : ℤ × ℤ) : Prop := ¬ ((c : ℤ) < (c : ℤ) + (d : ℤ) * q.1 ∧ (c : ℤ) + (d : ℤ) * q.1 < (L : ℤ) ∧ (R : ℤ) < (c : ℤ) + (d : ℤ) * q.2) theorem large_step_affine_avoids_corner {c L R d : ℕ} (hLd : L ≤ c + d) (q : ℤ × ℤ) : AffineAvoidsCorner c L R d q := by rintro ⟨hc, hL, hR⟩ have hd : (0 : ℤ) ≤ d := Nat.cast_nonneg d rcases le_or_gt q.1 0 with hq | hq · have hprod := mul_nonpos_of_nonneg_of_nonpos hd hq omega · have hq1 : (1 : ℤ) ≤ q.1 := by omega have hprod := mul_le_mul_of_nonneg_left hq1 hd have hLdI : (L : ℤ) ≤ (c : ℤ) + (d : ℤ) := by exact_mod_cast hLd nlinarith theorem normalized_bounds_avoid_corner {c L R d : ℕ} {q : ℤ × ℤ} (hcL : c < L) (hLR : L ≤ R) (hd : 0 < d) (hq : q.2 ≤ (((R - c) / d : ℕ) : ℤ) ∨ ((((L - c) / d + 1 : ℕ) : ℤ) ≤ q.1)) : AffineAvoidsCorner c L R d q := by rintro ⟨hc, hL, hR⟩ have hdI : (0 : ℤ) ≤ d := Nat.cast_nonneg d have hRc : R - c + c = R := Nat.sub_add_cancel (hcL.le.trans hLR) have hLc : L - c + c = L := Nat.sub_add_cancel hcL.le rcases hq with hq | hq · have hbase : c + d * ((R - c) / d) ≤ R := by have hh := Nat.mul_div_le (R - c) d nlinarith have hbaseI : (c : ℤ) + (d : ℤ) * (((R - c) / d : ℕ) : ℤ) ≤ R := by exact_mod_cast hbase have hprod := mul_le_mul_of_nonneg_left hq hdI linarith · have hbase : L < c + d * ((L - c) / d + 1) := by have hh : L - c < ((L - c) / d + 1) * d := (Nat.div_lt_iff_lt_mul hd).mp (by omega) nlinarith have hbaseI : (L : ℤ) < (c : ℤ) + (d : ℤ) * (((L - c) / d + 1 : ℕ) : ℤ) := by exact_mod_cast hbase have hprod := mul_le_mul_of_nonneg_left hq hdI linarith theorem liftPair_avoids_corner {c L R d : ℕ} {q : ℤ × ℤ} {p : ProgressionCell} {S : Finset ℕ} (hmodel : IsCenteredModel c d p S) (hp : PrimitiveBadPair p q) (havoid : AffineAvoidsCorner c L R d q) : ¬ (c < (liftPair c d q).1 ∧ (liftPair c d q).1 < L ∧ R < (liftPair c d q).2) := by rintro ⟨hc, hL, hR⟩ have hcoords := primitive_pair_coordinates hp have hx : ((liftPair c d q).1 : ℤ) = (c : ℤ) + (d : ℤ) * q.1 := (centered_point_mem hmodel hcoords.1).2 have hy : ((liftPair c d q).2 : ℤ) = (c : ℤ) + (d : ℤ) * q.2 := (centered_point_mem hmodel hcoords.2).2 apply havoid have hcI : (c : ℤ) < ((liftPair c d q).1 : ℤ) := by exact_mod_cast hc have hLI : ((liftPair c d q).1 : ℤ) < (L : ℤ) := by exact_mod_cast hL have hRI : (R : ℤ) < ((liftPair c d q).2 : ℤ) := by exact_mod_cast hR exact ⟨by simpa only [hx] using hcI, by simpa only [hx] using hLI, by simpa only [hy] using hRI⟩ theorem exists_normalized_corner_matching {N c L R d : ℕ} (hcL : c < L) (hLR : L ≤ R) (hRN : R ≤ N) (hd : 0 < d) (hN : 256 * (L + N - R) * (Nat.log 2 N + 1) ≤ N) : ∃ f : ProgressionCell → Option (ℤ × ℤ), (∀ p q, f p = some q → PrimitiveBadPair p q ∧ AffineAvoidsCorner c L R d q) ∧ (∀ p p' q, f p = some q → f p' = some q → p = p') ∧ (∀ Q : Finset ProgressionCell, (∀ p ∈ Q, p.val.1 ≤ c / d ∧ p.val.2 ≤ N / d) → (Q.filter (fun p => f p = none)).card ≤ 20000) := by by_cases hdt : d ≤ L + N - R · obtain ⟨f, hvalid, hinj, hmiss⟩ := exists_bounded_corner_matching (A := (L - c) / d + 1) (B := (R - c) / d) (C := c / d) (M := N / d) (corner_normalized_threshold hcL hLR hRN hd hdt hN) (fun r hr hrN => corner_totient_row_supply hcL hLR hRN hd hdt hN hr hrN) refine ⟨f, ?_, hinj, ?_⟩ · intro p q hpq have hh := hvalid p q hpq exact ⟨hh.1, normalized_bounds_avoid_corner hcL hLR hd hh.2⟩ · intro Q hQ exact hmiss Q (fun p hp => mem_boundedProgressionCells.mpr (hQ p hp)) · obtain ⟨f, hvalid, hinj, hmiss⟩ := exists_progression_pair_matching refine ⟨f, ?_, hinj, fun Q _ => hmiss Q⟩ intro p q hpq have hLd : L ≤ c + d := by omega exact ⟨hvalid p q hpq, large_step_affine_avoids_corner hLd q⟩ theorem exists_natural_corner_pair_matching {N c L R : ℕ} {F : Finset (Finset ℕ)} (hcL : c < L) (hLR : L ≤ R) (hRN : R ≤ N) (hN : 256 * (L + N - R) * (Nat.log 2 N + 1) ≤ N) (hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hcard : ∀ S ∈ F, 4 ≤ S.card) (hcenter : ∀ S ∈ F, c ∈ S) : ∃ f : {S // S ∈ F} → Option (ℕ × ℕ), (∀ S q, f S = some q → ∃ d : ℕ, 0 < d ∧ d ≤ N ∧ NaturalMatchedPair c d S.val q ∧ ¬ (c < q.1 ∧ q.1 < L ∧ R < q.2)) ∧ (∀ S T q, f S = some q → f T = some q → S = T) ∧ (Finset.univ.filter (fun S => f S = none)).card ≤ 20000 * N := by apply exists_natural_progression_pair_matching_constrained hsub hAP hcard hcenter intro d hd hdN obtain ⟨f, hvalid, hinj, hmiss⟩ := exists_normalized_corner_matching hcL hLR hRN hd hN refine ⟨f, ?_, hinj, hmiss⟩ intro p q hpq have hh := hvalid p q hpq exact ⟨hh.1, fun S hS => liftPair_avoids_corner hS hh.1 hh.2⟩ end section open Finset theorem exists_consecutive_left_of_mem {S : Finset ℕ} {x c : ℕ} (hx : x ∈ S) (hc : c ∈ S) (hxc : x < c) : ∃ a, ConsecutiveIn S a c := by let B := S.filter (fun a => a < c) have hB : B.Nonempty := ⟨x, Finset.mem_filter.mpr ⟨hx, hxc⟩⟩ let a := B.max' hB have haB : a ∈ B := Finset.max'_mem B hB obtain ⟨haS, hac⟩ := Finset.mem_filter.mp haB refine ⟨a, haS, hc, hac, ?_⟩ intro y hy hbetween have hyB : y ∈ B := Finset.mem_filter.mpr ⟨hy, hbetween.2⟩ have hya : y ≤ a := Finset.le_max' B y hyB omega theorem exists_consecutive_right_of_mem {S : Finset ℕ} {c x : ℕ} (hc : c ∈ S) (hx : x ∈ S) (hcx : c < x) : ∃ a, ConsecutiveIn S c a := by let B := S.filter (fun a => c < a) have hB : B.Nonempty := ⟨x, Finset.mem_filter.mpr ⟨hx, hcx⟩⟩ let a := B.min' hB have haB : a ∈ B := Finset.min'_mem B hB obtain ⟨haS, hca⟩ := Finset.mem_filter.mp haB refine ⟨a, hc, haS, hca, ?_⟩ intro y hy hbetween have hyB : y ∈ B := Finset.mem_filter.mpr ⟨hy, hbetween.1⟩ have hay : a ≤ y := Finset.min'_le B y hyB omega theorem consecutive_AP_core {S : Finset ℕ} {u v : ℕ} (hcon : ConsecutiveIn S u v) : ∃ U : Finset ℕ, U ⊆ S ∧ (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) ∧ u ∈ U ∧ v ∈ U ∧ ∀ x : ℕ, HasAPCover S {u, v, x} ↔ x ∈ U := by classical let D : Finset (Finset ℕ) := S.powerset.filter (fun T : Finset ℕ => (∃ l : ℕ∞, (T : Set ℕ).IsAPOfLength l) ∧ u ∈ T ∧ v ∈ T) let U : Finset ℕ := D.biUnion id have hpairS : {u, v} ⊆ S := by simp [Finset.insert_subset_iff, hcon.1, hcon.2.1] have hpairAP : (({u, v} : Finset ℕ) : Set ℕ).IsAPOfLength 2 := by simpa using Nat.isAPOfLength_pair hcon.2.2.1 have hpairD : {u, v} ∈ D := Finset.mem_filter.mpr ⟨Finset.mem_powerset.mpr hpairS, ⟨2, hpairAP⟩, by simp, by simp⟩ have huU : u ∈ U := Finset.mem_biUnion.mpr ⟨{u, v}, hpairD, by simp⟩ have hvU : v ∈ U := Finset.mem_biUnion.mpr ⟨{u, v}, hpairD, by simp⟩ have hUclass : FixedGapAP u v U := union_closed_biUnion (fixedGapAP_empty u v) (fun S T hS hT => fixedGapAP_union hS hT) D id (by intro T hT obtain ⟨hTS, hAP, huT, hvT⟩ := Finset.mem_filter.mp hT exact Or.inr ⟨hAP, hcon.subset (Finset.mem_powerset.mp hTS) huT hvT⟩) have hUAP : ∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l := by rcases hUclass with heq | h · simp [heq] at huU · exact h.1 have hUsub : U ⊆ S := by intro x hx obtain ⟨T, hT, hxT⟩ := Finset.mem_biUnion.mp hx exact Finset.mem_powerset.mp (Finset.mem_filter.mp hT).1 hxT refine ⟨U, hUsub, hUAP, huU, hvU, ?_⟩ intro x constructor · rintro ⟨T, hTS, hAP, hcover⟩ have hTD : T ∈ D := Finset.mem_filter.mpr ⟨Finset.mem_powerset.mpr hTS, hAP, hcover (by simp), hcover (by simp)⟩ exact Finset.mem_biUnion.mpr ⟨T, hTD, hcover (by simp)⟩ · intro hx exact ⟨U, hUsub, hUAP, by simp [Finset.insert_subset_iff, huU, hvU, hx]⟩ theorem natAP_first_eq_of_min {a c d k : ℕ} (hc : c ∈ natAP a d k) (hmin : ∀ x ∈ natAP a d k, c ≤ x) : a = c := by obtain ⟨i, hi, hci⟩ := mem_natAP.mp hc have ha : a ∈ natAP a d k := mem_natAP.mpr ⟨0, by omega, by simp⟩ have hca := hmin a ha omega theorem nat_ap_eq_at_min {S : Finset ℕ} {c : ℕ} (hAP : ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hcard : 2 ≤ S.card) (hc : c ∈ S) (hmin : ∀ x ∈ S, c ≤ x) : ∃ d : ℕ, 0 < d ∧ S = natAP c d S.card := by obtain ⟨l, hAP⟩ := hAP obtain ⟨a, d, hd, heq⟩ := nat_ap_eq_natAP hAP hcard have hac : a = c := natAP_first_eq_of_min (heq ▸ hc) (fun x hx => hmin x (heq.symm ▸ hx)) exact ⟨d, hd, by simpa only [hac] using heq⟩ theorem natAP_filter_le {a d k R : ℕ} (hd : 0 < d) (haR : a ≤ R) : (natAP a d k).filter (fun x => x ≤ R) = natAP a d (min k ((R - a) / d + 1)) := by ext x simp only [Finset.mem_filter, mem_natAP] constructor · rintro ⟨⟨i, hi, heq⟩, hxR⟩ refine ⟨i, lt_min hi ?_, heq⟩ apply Nat.lt_succ_of_le apply (Nat.le_div_iff_mul_le hd).mpr omega · rintro ⟨i, hi, heq⟩ obtain ⟨hik, hiR⟩ := lt_min_iff.mp hi refine ⟨⟨i, hik, heq⟩, ?_⟩ have hh : i * d ≤ R - a := (Nat.le_div_iff_mul_le hd).mp (by omega : i ≤ (R - a) / d) omega theorem hasAPCover_of_not_witness {S P : Finset ℕ} {c : ℕ} (hcard : P.card = 2) (hsub : P ⊆ S.erase c) (hnot : ¬ IsWitnessPair S c P) : HasAPCover S (insert c P) := by by_contra hcover exact hnot ⟨hcard, hsub, hcover⟩ theorem hasAPCover_at_min {S : Finset ℕ} {c x y : ℕ} (hmin : ∀ z ∈ S, c ≤ z) (hcx : c < x) (hcover : HasAPCover S {c, x, y}) : ∃ d k : ℕ, 0 < d ∧ 2 ≤ k ∧ natAP c d k ⊆ S ∧ x ∈ natAP c d k ∧ y ∈ natAP c d k := by obtain ⟨U, hUS, hUAP, hUcover⟩ := hcover have hcU : c ∈ U := hUcover (by simp) have hxU : x ∈ U := hUcover (by simp) have hyU : y ∈ U := hUcover (by simp) have hUcard : 2 ≤ U.card := by have hsub : {c, x} ⊆ U := by simp [Finset.insert_subset_iff, hcU, hxU] simpa [hcx.ne] using Finset.card_le_card hsub obtain ⟨d, hd, heq⟩ := nat_ap_eq_at_min hUAP hUcard hcU (fun z hz => hmin z (hUS hz)) exact ⟨d, U.card, hd, hUcard, heq ▸ hUS, heq ▸ hxU, heq ▸ hyU⟩ end section open Finset def InExteriorCorner (c L R : ℕ) (P : Finset ℕ) : Prop := ∃ u v : ℕ, c < u ∧ u < L ∧ R < v ∧ P = {u, v} theorem exterior_corner_pair_iff {c L R u v : ℕ} (hLR : L ≤ R) (huv : u < v) : InExteriorCorner c L R {u, v} ↔ c < u ∧ u < L ∧ R < v := by constructor · rintro ⟨a, b, hca, haL, hRb, heq⟩ have hab : a < b := by omega have hpair := sorted_pair_finset_injective huv hab heq have hua : u = a := congrArg Prod.fst hpair have hvb : v = b := congrArg Prod.snd hpair exact ⟨by omega, by omega, by omega⟩ · rintro ⟨hcu, huL, hRv⟩ exact ⟨u, v, hcu, huL, hRv, rfl⟩ theorem exterior_corner_mem_gt {c L R x : ℕ} {P : Finset ℕ} (hLR : L ≤ R) (hP : InExteriorCorner c L R P) (hx : x ∈ P) : c < x := by obtain ⟨u, v, hcu, huL, hRv, rfl⟩ := hP simp only [Finset.mem_insert, Finset.mem_singleton] at hx omega theorem exterior_witness_min {S : Finset ℕ} {c L R : ℕ} (hcrooked : IsCrooked S) (hc : c ∈ S) (hLR : L ≤ R) (hcorner : ∀ P, IsWitnessPair S c P → InExteriorCorner c L R P) : ∀ x ∈ S, c ≤ x := by intro x hx by_contra hcx obtain ⟨a, ha⟩ := exists_consecutive_left_of_mem hx hc (by omega) obtain ⟨b, hb⟩ := witness_pair_of_left_neighbor hcrooked ha have hca := exterior_corner_mem_gt hLR (hcorner {a, b} hb) (by simp : a ∈ ({a, b} : Finset ℕ)) have hac := ha.2.2.1 omega theorem exterior_witness_neighbor {S : Finset ℕ} {c L R : ℕ} (hcrooked : IsCrooked S) (hc : c ∈ S) (hLR : L ≤ R) (hcorner : ∀ P, IsWitnessPair S c P → InExteriorCorner c L R P) : ∃ a : ℕ, ConsecutiveIn S c a ∧ a < L := by have hmin := exterior_witness_min hcrooked hc hLR hcorner obtain ⟨a, ha | ha⟩ := exists_consecutive_at_mem hc (crooked_card_ge_two hcrooked hc) · have hh := hmin a ha.1 have hlt := ha.2.2.1 omega · obtain ⟨b, hb⟩ := witness_pair_of_right_neighbor hcrooked ha obtain ⟨u, v, hcu, huL, hRv, hpair⟩ := hcorner {a, b} hb have haPair : a = u ∨ a = v := by have hh : a ∈ ({u, v} : Finset ℕ) := by rw [← hpair]; simp simpa only [Finset.mem_insert, Finset.mem_singleton] using hh refine ⟨a, ha, ?_⟩ rcases haPair with rfl | rfl · exact huL · have huS : u ∈ S := Finset.mem_of_mem_erase (hb.2.1 (by rw [hpair]; simp)) exact False.elim (ha.2.2.2 u huS ⟨hcu, by omega⟩) theorem exterior_witness_prefix {S : Finset ℕ} {c L R : ℕ} (hcrooked : IsCrooked S) (hc : c ∈ S) (hLR : L ≤ R) (hcorner : ∀ P, IsWitnessPair S c P → InExteriorCorner c L R P) : ∃ d h : ℕ, 0 < d ∧ d < L - c ∧ 1 ≤ h ∧ (∀ x ∈ S, c ≤ x) ∧ S.filter (fun x => x ≤ R) = natAP c d (h + 1) ∧ c + h * d ≤ R ∧ ∃ v ∈ S, R < v := by have hmin := exterior_witness_min hcrooked hc hLR hcorner obtain ⟨a, hcon, haL⟩ := exterior_witness_neighbor hcrooked hc hLR hcorner have hca := hcon.2.2.1 have hcR : c ≤ R := by omega obtain ⟨U, hUS, hUAP, hcU, haU, hcover⟩ := consecutive_AP_core hcon have hconU := hcon.subset hUS hcU haU have hUcard := hconU.card_ge_two obtain ⟨d, hd, heq⟩ := nat_ap_eq_at_min hUAP hUcard hcU (fun x hx => hmin x (hUS hx)) have hgap : d = a - c := natAP_step_of_consecutive hd (heq ▸ hconU) have hcad : c + d = a := by omega have hprefix : S.filter (fun x => x ≤ R) = U.filter (fun x => x ≤ R) := by ext x simp only [Finset.mem_filter] constructor · rintro ⟨hxS, hxR⟩ refine ⟨?_, hxR⟩ by_cases hxc : x = c · simpa only [hxc] using hcU by_cases hxa : x = a · simpa only [hxa] using haU apply (hcover x).mp apply hasAPCover_of_not_witness (by simp [Ne.symm hxa]) · intro y hy simp only [Finset.mem_insert, Finset.mem_singleton] at hy rcases hy with rfl | rfl · exact Finset.mem_erase.mpr ⟨hca.ne', hcon.2.1⟩ · exact Finset.mem_erase.mpr ⟨hxc, hxS⟩ · intro hW obtain ⟨u, v, hcu, huL, hRv, he⟩ := hcorner {a, x} hW have hv : v = a ∨ v = x := by have hh : v ∈ ({a, x} : Finset ℕ) := by rw [he]; simp simpa only [Finset.mem_insert, Finset.mem_singleton] using hh omega · rintro ⟨hxU, hxR⟩ exact ⟨hUS hxU, hxR⟩ rw [heq, natAP_filter_le hd hcR] at hprefix let k := min U.card ((R - c) / d + 1) have hk : 2 ≤ k := by apply le_min hUcard have hdiv : 1 ≤ (R - c) / d := (Nat.le_div_iff_mul_le hd).mpr (by omega) omega let h := k - 1 have hkh : k = h + 1 := by dsimp [h]; omega have hprefix' : S.filter (fun x => x ≤ R) = natAP c d (h + 1) := by change S.filter (fun x => x ≤ R) = natAP c d k at hprefix simpa only [hkh] using hprefix have htop : c + h * d ∈ S.filter (fun x => x ≤ R) := by rw [hprefix'] exact mem_natAP.mpr ⟨h, by omega, rfl⟩ have htail : ∃ v ∈ S, R < v := by by_contra! hh have hfilter : S.filter (fun x => x ≤ R) = S := Finset.filter_eq_self.mpr hh apply hcrooked refine ⟨(h + 1 : ℕ), ?_⟩ rw [← hfilter, hprefix'] exact natAP_isAP hd exact ⟨d, h, hd, by omega, by dsimp [h]; omega, hmin, hprefix', (Finset.mem_filter.mp htop).2, htail⟩ end section open Finset theorem totient_le_of_no_coprime_middle {m a h : ℕ} (hgap : ∀ j : ℕ, a ≤ j → j ≤ h → ¬ j.Coprime m) : m.totient ≤ 2 * a + (m - 2 * h) := by let D := (Finset.Icc 1 m).filter (fun j => m.Coprime j) let U := Finset.range a ∪ (Finset.range a).image (fun j => m - j) ∪ Finset.Ioo h (m - h) have hcover : D ⊆ U := by intro j hj obtain ⟨hjI, hcop⟩ := Finset.mem_filter.mp hj have hjm := (Finset.mem_Icc.mp hjI).2 by_cases hja : j < a · exact Finset.mem_union_left _ (Finset.mem_union_left _ (Finset.mem_range.mpr hja)) by_cases hjh : j ≤ h · exact False.elim (hgap j (by omega) hjh hcop.symm) by_cases hma : m - j < a · apply Finset.mem_union_left apply Finset.mem_union_right exact Finset.mem_image.mpr ⟨m - j, Finset.mem_range.mpr hma, by omega⟩ by_cases hmh : m - j ≤ h · have hcop' : (m - j).Coprime m := (Nat.coprime_self_sub_left hjm).mpr hcop.symm exact False.elim (hgap (m - j) (by omega) hmh hcop') · exact Finset.mem_union_right _ (Finset.mem_Ioo.mpr ⟨by omega, by omega⟩) have hmid : (Finset.Ioo h (m - h)).card ≤ m - 2 * h := by simp only [Nat.card_Ioo] omega have himage : ((Finset.range a).image (fun j => m - j)).card ≤ a := by simpa using Finset.card_image_le (s := Finset.range a) (f := fun j => m - j) have hUcard : U.card ≤ 2 * a + (m - 2 * h) := by have h1 := Finset.card_union_le (Finset.range a) ((Finset.range a).image (fun j => m - j)) have h2 := Finset.card_union_le (Finset.range a ∪ (Finset.range a).image (fun j => m - j)) (Finset.Ioo h (m - h)) simp only [Finset.card_range] at h1 change U.card ≤ _ at h2 omega have hD : D.card = m.totient := card_coprime_Icc m rw [← hD] exact (Finset.card_le_card hcover).trans hUcard theorem exists_coprime_middle {m a h : ℕ} (hlarge : (2 * a + (m - 2 * h)) * (Nat.log 2 m + 1) < m) : ∃ j : ℕ, a ≤ j ∧ j ≤ h ∧ j.Coprime m := by by_contra hnone have hphi : m.totient ≤ 2 * a + (m - 2 * h) := totient_le_of_no_coprime_middle (fun j haj hjh hjcop => hnone ⟨j, haj, hjh, hjcop⟩) have hh := (le_log_succ_mul_totient m).trans (Nat.mul_le_mul_left (Nat.log 2 m + 1) hphi) nlinarith theorem exists_coprime_in_prefix_core {N c L R d h m : ℕ} (hcL : c < L) (hLR : L ≤ R) (hRN : R ≤ N) (hd : 0 < d) (hdL : d ≤ L) (hN : 256 * (L + N - R) * (Nat.log 2 N + 1) ≤ N) (hmR : R < c + m * d) (hmN : c + m * d ≤ N) (hhalf : R + c < 2 * (c + h * d)) : ∃ j : ℕ, L ≤ c + j * d ∧ j ≤ h ∧ j.Coprime m := by let t := L + N - R let a := (L - c) / d + 1 let q := 2 * a + (m - 2 * h) let K := Nat.log 2 N + 1 have hLt : L ≤ t := by dsimp [t]; omega have hct : c ≤ t := hcL.le.trans hLt have htp : 0 < t := by omega have htR : t + R = L + N := by dsimp [t]; omega have hNR : N - R + R = N := Nat.sub_add_cancel hRN have hLc : L - c + c = L := Nat.sub_add_cancel hcL.le have hmN' : m ≤ N := by have hmul : m ≤ m * d := Nat.le_mul_of_pos_right m hd omega have ha : d * a ≤ L - c + d := by have hh := Nat.mul_div_le (L - c) d dsimp [a] nlinarith have hmid : d * (m - 2 * h) ≤ N - R := by by_cases hmh : 2 * h ≤ m · have heq : m - 2 * h + 2 * h = m := Nat.sub_add_cancel hmh nlinarith · have heq : m - 2 * h = 0 := by omega simp [heq] have hq : d * q ≤ 4 * t := by dsimp [q] nlinarith have hK : 1 ≤ K := by dsimp [K]; omega have hlog : Nat.log 2 m + 1 ≤ K := Nat.add_le_add_right (Nat.log_mono_right hmN') 1 have hlarge : q * (Nat.log 2 m + 1) < m := by by_contra hh have hm : m ≤ q * K := (by omega : m ≤ q * (Nat.log 2 m + 1)).trans (Nat.mul_le_mul_left q hlog) have hbound : d * m ≤ 4 * t * K := by calc d * m ≤ d * (q * K) := Nat.mul_le_mul_left d hm _ = (d * q) * K := by ring _ ≤ (4 * t) * K := Nat.mul_le_mul_right K hq change 256 * t * K ≤ N at hN have hprod : t ≤ t * K := by nlinarith nlinarith obtain ⟨j, haj, hjh, hjcop⟩ := exists_coprime_middle hlarge refine ⟨j, ?_, hjh, hjcop⟩ have hj : (L - c) / d < j := by change (L - c) / d + 1 ≤ j at haj; omega have hmul : L - c < j * d := (Nat.div_lt_iff_lt_mul hd).mp hj omega end section open Finset theorem prefix_top_mem {S : Finset ℕ} {c d h R : ℕ} (hprefix : S.filter (fun x => x ≤ R) = natAP c d (h + 1)) : c + h * d ∈ S := by have hh : c + h * d ∈ S.filter (fun x => x ≤ R) := by rw [hprefix] exact mem_natAP.mpr ⟨h, by omega, rfl⟩ exact (Finset.mem_filter.mp hh).1 theorem prefix_le_top {S : Finset ℕ} {c d h R x : ℕ} (hprefix : S.filter (fun y => y ≤ R) = natAP c d (h + 1)) (hx : x ∈ S) (hxR : x ≤ R) : x ≤ c + h * d := by have hh : x ∈ natAP c d (h + 1) := hprefix ▸ Finset.mem_filter.mpr ⟨hx, hxR⟩ obtain ⟨i, hi, hxi⟩ := mem_natAP.mp hh have hmul := Nat.mul_le_mul_right d (by omega : i ≤ h) omega theorem prefix_dvd_offset {S : Finset ℕ} {c d h R x : ℕ} (hprefix : S.filter (fun y => y ≤ R) = natAP c d (h + 1)) (hx : x ∈ S) (hxR : x ≤ R) : d ∣ x - c := by have hh : x ∈ natAP c d (h + 1) := hprefix ▸ Finset.mem_filter.mpr ⟨hx, hxR⟩ obtain ⟨i, hi, hxi⟩ := mem_natAP.mp hh refine ⟨i, ?_⟩ rw [← hxi, Nat.add_sub_cancel_left, Nat.mul_comm] theorem prefix_step_divides_cover_step {S : Finset ℕ} {c d h R e k x : ℕ} (hprefix : S.filter (fun y => y ≤ R) = natAP c d (h + 1)) (_he : 0 < e) (hcover : natAP c e k ⊆ S) (hcx : c < x) (hx : x ∈ natAP c e k) (hxR : x ≤ R) : d ∣ e := by obtain ⟨i, hi, hxi⟩ := mem_natAP.mp hx have hi1 : 1 ≤ i := by by_contra hh have hi0 : i = 0 := by omega simp only [hi0, zero_mul, add_zero] at hxi omega have hstep : c + e ∈ S := hcover (mem_natAP.mpr ⟨1, by omega, by simp⟩) have hmul := Nat.mul_le_mul_right e hi1 have hstepR : c + e ≤ R := by omega simpa only [Nat.add_sub_cancel_left] using prefix_dvd_offset hprefix hstep hstepR theorem distant_consecutive_witness {S : Finset ℕ} {c x y : ℕ} (hmin : ∀ z ∈ S, c ≤ z) (hcx : c < x) (hcon : ConsecutiveIn S x y) (hgap : 2 * x < c + y) : IsWitnessPair S c {x, y} := by refine ⟨by simp [hcon.2.2.1.ne], ?_, ?_⟩ · intro z hz simp only [Finset.mem_insert, Finset.mem_singleton] at hz rcases hz with rfl | rfl · exact Finset.mem_erase.mpr ⟨hcx.ne', hcon.1⟩ · exact Finset.mem_erase.mpr ⟨by have hh := hcon.2.2.1; omega, hcon.2.1⟩ · intro hcover obtain ⟨e, k, he, hk, hAS, hxA, hyA⟩ := hasAPCover_at_min hmin hcx hcover have hconA := hcon.subset hAS hxA hyA have hstep : e = y - x := natAP_step_of_consecutive he hconA obtain ⟨i, hi, hxi⟩ := mem_natAP.mp hxA have hi1 : 1 ≤ i := by by_contra hh have hi0 : i = 0 := by omega simp only [hi0, zero_mul, add_zero] at hxi omega have hmul := Nat.mul_le_mul_right e hi1 have hxy := hcon.2.2.1 omega theorem prefix_top_cover_analysis {S : Finset ℕ} {c d h R v : ℕ} (hd : 0 < d) (hh : 1 ≤ h) (hprefix : S.filter (fun x => x ≤ R) = natAP c d (h + 1)) (hmin : ∀ x ∈ S, c ≤ x) (htopR : c + h * d ≤ R) (hvR : R < v) (hcover : HasAPCover S {c, c + h * d, v}) : d ∣ v - c ∧ R + c < 2 * (c + h * d) := by let z := c + h * d have hcz : c < z := by have hpos : 0 < h * d := Nat.mul_pos (by omega) hd dsimp [z] omega obtain ⟨e, k, he, hk, hAS, hzA, hvA⟩ := hasAPCover_at_min hmin hcz hcover have hde : d ∣ e := prefix_step_divides_cover_step hprefix he hAS hcz hzA htopR obtain ⟨i, hi, hzi⟩ := mem_natAP.mp hzA obtain ⟨j, hj, hvj⟩ := mem_natAP.mp hvA have hi1 : 1 ≤ i := by by_contra hlt have hi0 : i = 0 := by omega simp only [hi0, zero_mul, add_zero] at hzi omega have hij : i < j := by by_contra hlt have hmul := Nat.mul_le_mul_right e (by omega : j ≤ i) dsimp [z] at hzi omega have hzstep : z + e ∈ S := hAS (mem_natAP.mpr ⟨i + 1, by omega, by nlinarith⟩) have hzstepR : R < z + e := by by_contra hle have hbound := prefix_le_top hprefix hzstep (by omega : z + e ≤ R) change z + e ≤ z at hbound omega constructor · have hev : e ∣ v - c := by refine ⟨j, ?_⟩ rw [← hvj, Nat.add_sub_cancel_left, Nat.mul_comm] exact hde.trans hev · have hmul := Nat.mul_le_mul_right e hi1 change R + c < 2 * z omega theorem prefix_reaches_core {S : Finset ℕ} {c L R d h : ℕ} (hd : 0 < d) (hh : 1 ≤ h) (hprefix : S.filter (fun x => x ≤ R) = natAP c d (h + 1)) (hmin : ∀ x ∈ S, c ≤ x) (htopR : c + h * d ≤ R) (htail : ∃ v ∈ S, R < v) (hwide : 2 * L ≤ R + c) (hbetween : ∀ u v : ℕ, u < v → IsWitnessPair S c {u, v} → ∃ x ∈ S, u < x ∧ x < v) : L ≤ c + h * d := by let z := c + h * d by_contra hzL let B := S.filter (fun v => R < v) have hB : B.Nonempty := by obtain ⟨v, hvS, hRv⟩ := htail exact ⟨v, Finset.mem_filter.mpr ⟨hvS, hRv⟩⟩ let v := B.min' hB obtain ⟨hvS, hRv⟩ := Finset.mem_filter.mp (Finset.min'_mem B hB) have hzS : z ∈ S := prefix_top_mem hprefix have hcz : c < z := by have hpos : 0 < h * d := Nat.mul_pos (by omega) hd dsimp [z] omega have hcon : ConsecutiveIn S z v := by refine ⟨hzS, hvS, by dsimp [z]; omega, ?_⟩ intro x hx hzxv by_cases hxR : x ≤ R · have hh := prefix_le_top hprefix hx hxR change x ≤ z at hh omega · have hxB : x ∈ B := Finset.mem_filter.mpr ⟨hx, by omega⟩ have hvx : v ≤ x := Finset.min'_le B x hxB omega have hgap : 2 * z < c + v := by omega have hW := distant_consecutive_witness hmin hcz hcon hgap obtain ⟨x, hxS, hzx, hxv⟩ := hbetween z v hcon.2.2.1 hW exact hcon.2.2.2 x hxS ⟨hzx, hxv⟩ end section open Finset theorem exterior_witness_contradiction {N c L R : ℕ} {S : Finset ℕ} (hcL : c < L) (hLR : L ≤ R) (hRN : R ≤ N) (hN : 256 * (L + N - R) * (Nat.log 2 N + 1) ≤ N) (hsub : S ⊆ Finset.Icc 1 N) (hcrooked : IsCrooked S) (hc : c ∈ S) (hcorner : ∀ P, IsWitnessPair S c P → InExteriorCorner c L R P) (hbetween : ∀ u v : ℕ, u < v → IsWitnessPair S c {u, v} → ∃ x ∈ S, u < x ∧ x < v) : False := by obtain ⟨d, h, hd, hdL, hh, hmin, hprefix, htopR, htail⟩ := exterior_witness_prefix hcrooked hc hLR hcorner let z := c + h * d have hzS : z ∈ S := prefix_top_mem hprefix have hcz : c < z := by have hpos := Nat.mul_pos (by omega : 0 < h) hd dsimp [z] omega have hwide : 2 * L ≤ R + c := by have hmul : 256 * (L + N - R) ≤ 256 * (L + N - R) * (Nat.log 2 N + 1) := Nat.le_mul_of_pos_right _ (by omega) omega have hzL : L ≤ z := prefix_reaches_core hd hh hprefix hmin htopR htail hwide hbetween have htopCover : ∀ v ∈ S, R < v → HasAPCover S {c, z, v} := by intro v hvS hRv have hzv : z < v := by dsimp [z]; omega apply hasAPCover_of_not_witness (by simp [hzv.ne]) · intro x hx simp only [Finset.mem_insert, Finset.mem_singleton] at hx rcases hx with rfl | rfl · exact Finset.mem_erase.mpr ⟨hcz.ne', hzS⟩ · exact Finset.mem_erase.mpr ⟨by omega, hvS⟩ · intro hW have hbad := (exterior_corner_pair_iff hLR hzv).mp (hcorner {z, v} hW) omega have hgrid : ∀ x ∈ S, d ∣ x - c := by intro x hx by_cases hxR : x ≤ R · exact prefix_dvd_offset hprefix hx hxR · exact (prefix_top_cover_analysis hd hh hprefix hmin htopR (by omega) (htopCover x hx (by omega))).1 have hSnonempty : S.Nonempty := ⟨c, hc⟩ let v := S.max' hSnonempty have hvS : v ∈ S := Finset.max'_mem S hSnonempty have hmax : ∀ x ∈ S, x ≤ v := fun x hx => Finset.le_max' S x hx have hRv : R < v := by obtain ⟨w, hwS, hRw⟩ := htail have hwv := hmax w hwS omega have hcv : c ≤ v := hmin v hvS have hvN : v ≤ N := (Finset.mem_Icc.mp (hsub hvS)).2 obtain ⟨m, hm⟩ := hgrid v hvS have hvm : v = c + m * d := by have hvsub := Nat.sub_add_cancel hcv nlinarith only [hm, hvsub] have hhalf : R + c < 2 * (c + h * d) := (prefix_top_cover_analysis hd hh hprefix hmin htopR hRv (htopCover v hvS hRv)).2 obtain ⟨j, hjL, hjh, hjcop⟩ := exists_coprime_in_prefix_core hcL hLR hRN hd (by omega : d ≤ L) hN (by simpa only [hvm] using hRv) (by simpa only [hvm] using hvN) hhalf let u := c + j * d have huR : u ≤ R := by have hmul := Nat.mul_le_mul_right d hjh dsimp [u] omega have huS : u ∈ S := by have hu : u ∈ S.filter (fun x => x ≤ R) := by rw [hprefix] exact mem_natAP.mpr ⟨j, by omega, rfl⟩ exact (Finset.mem_filter.mp hu).1 have hcu : c < u := by dsimp [u]; omega have huv : u < v := by omega have huCover : HasAPCover S {c, u, v} := by apply hasAPCover_of_not_witness (by simp [huv.ne]) · intro x hx simp only [Finset.mem_insert, Finset.mem_singleton] at hx rcases hx with rfl | rfl · exact Finset.mem_erase.mpr ⟨hcu.ne', huS⟩ · exact Finset.mem_erase.mpr ⟨by omega, hvS⟩ · intro hW have hbad := (exterior_corner_pair_iff hLR huv).mp (hcorner {u, v} hW) dsimp [u] at hbad omega obtain ⟨e, k, he, hk, hAS, huA, hvA⟩ := hasAPCover_at_min hmin hcu huCover have hde : d ∣ e := prefix_step_divides_cover_step hprefix he hAS hcu huA huR obtain ⟨i, hi, hui⟩ := mem_natAP.mp huA obtain ⟨i', hi', hvi'⟩ := mem_natAP.mp hvA have hejd : e ∣ j * d := by refine ⟨i, ?_⟩ dsimp [u] at hui nlinarith only [hui] have hemd : e ∣ m * d := by refine ⟨i', ?_⟩ rw [hvm] at hvi' nlinarith only [hvi'] have hed : e ∣ d := by have hdiv := Nat.dvd_gcd hejd hemd have hgcd : (j * d).gcd (m * d) = d := by rw [Nat.gcd_mul_right, hjcop.gcd_eq_one, Nat.one_mul] simpa only [hgcd] using hdiv have hedEq : e = d := Nat.dvd_antisymm hed hde have hvA' : v ∈ natAP c d k := by simpa only [hedEq] using hvA have hAS' : natAP c d k ⊆ S := by simpa only [hedEq] using hAS have hSA : S ⊆ natAP c d k := by obtain ⟨b, hb, hvb⟩ := mem_natAP.mp hvA' intro x hx obtain ⟨a, ha⟩ := hgrid x hx have hcx : c ≤ x := hmin x hx have hxa : x = c + a * d := by have hsubx := Nat.sub_add_cancel hcx nlinarith only [hsubx, ha] have hxab : a ≤ b := by have hxv := hmax x hx by_contra hab have hmul := Nat.mul_lt_mul_of_pos_right (by omega : b < a) hd omega exact mem_natAP.mpr ⟨a, lt_of_le_of_lt hxab hb, hxa.symm⟩ have hS_eq : S = natAP c d k := Finset.Subset.antisymm hSA hAS' exact hcrooked ⟨k, hS_eq.symm ▸ natAP_isAP hd⟩ theorem exists_witness_outside_exterior_pairs {N c L R : ℕ} {S : Finset ℕ} {W : Finset (Finset ℕ)} (hcL : c < L) (hLR : L ≤ R) (hRN : R ≤ N) (hN : 256 * (L + N - R) * (Nat.log 2 N + 1) ≤ N) (hsub : S ⊆ Finset.Icc 1 N) (hcrooked : IsCrooked S) (hc : c ∈ S) (hW : ∀ P ∈ W, InExteriorCorner c L R P) (hbetween : ∀ u v : ℕ, u < v → ({u, v} : Finset ℕ) ∈ W → ∃ x ∈ S, u < x ∧ x < v) : ∃ P : Finset ℕ, IsWitnessPair S c P ∧ P ∉ W := by by_contra hnone have hinW : ∀ P, IsWitnessPair S c P → P ∈ W := by intro P hP by_contra hPW exact hnone ⟨P, hP, hPW⟩ exact exterior_witness_contradiction hcL hLR hRN hN hsub hcrooked hc (fun P hP => hW P (hinW P hP)) (fun u v huv hP => hbetween u v huv (hinW {u, v} hP)) end section open Finset theorem erase_not_mem_exterior_pairs {c L R : ℕ} {S : Finset ℕ} {W : Finset (Finset ℕ)} (hc : c ∈ S) (hLR : L ≤ R) (hW : ∀ P ∈ W, InExteriorCorner c L R P) (hbetween : ∀ u v : ℕ, u < v → ({u, v} : Finset ℕ) ∈ W → ∃ x ∈ S, u < x ∧ x < v) : S.erase c ∉ W := by intro hPW obtain ⟨u, v, hcu, huL, hRv, heq⟩ := hW (S.erase c) hPW have huv : u < v := by omega obtain ⟨x, hxS, hux, hxv⟩ := hbetween u v huv (by simpa only [heq] using hPW) have hS : S = insert c {u, v} := by rw [← heq, Finset.insert_erase hc] have hx : x = c ∨ x = u ∨ x = v := by simpa only [hS, Finset.mem_insert, Finset.mem_singleton] using hxS omega theorem exists_star_matching_outside_exterior_pairs {N c L R : ℕ} {F : Finset (Finset ℕ)} {W : Finset (Finset ℕ)} (hcL : c < L) (hLR : L ≤ R) (hRN : R ≤ N) (hN : 256 * (L + N - R) * (Nat.log 2 N + 1) ≤ N) (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hcard : ∀ S ∈ F, 3 ≤ S.card) (hW : ∀ P ∈ W, InExteriorCorner c L R P) (hbetween : ∀ S ∈ F, ∀ u v : ℕ, u < v → ({u, v} : Finset ℕ) ∈ W → ∃ x ∈ S, u < x ∧ x < v) : ∃ f : {S // S ∈ F} → Option (Finset ℕ), (∀ S P, f S = some P → P.card = 2 ∧ P ⊆ S.val.erase c) ∧ (∀ S P, f S = some P → P ∉ W) ∧ (∀ S T P, f S = some P → f T = some P → S = T) ∧ (Finset.univ.filter (fun S => f S = none)).card ≤ 20000 * N := by apply exists_common_point_pair_matching_allowed hF hc hcard · intro S hS hcrooked exact exists_witness_outside_exterior_pairs hcL hLR hRN hN (Finset.mem_powerset.mp (hF.1 hS)) hcrooked (hc S hS) hW (hbetween S hS) · intro S hS h3 exact erase_not_mem_exterior_pairs (hc S hS) hLR hW (hbetween S hS) · intro G hGF hAP h4 obtain ⟨g, hvalid, hinj, hmiss⟩ := exists_natural_corner_pair_matching hcL hLR hRN hN (fun S hS => Finset.mem_powerset.mp (hF.1 (hGF hS))) hAP h4 (fun S hS => hc S (hGF hS)) refine ⟨g, ?_, hinj, hmiss⟩ intro S q hq obtain ⟨d, hd, hdN, hnat, havoid⟩ := hvalid S q hq refine ⟨d, hd, hdN, hnat, ?_⟩ intro hPW exact havoid ((exterior_corner_pair_iff hLR hnat.2.2.1).mp (hW _ hPW)) theorem star_card_le_with_reserved_pairs {N c L R : ℕ} {F : Finset (Finset ℕ)} {W : Finset (Finset ℕ)} (hcL : c < L) (hLR : L ≤ R) (hRN : R ≤ N) (hN : 256 * (L + N - R) * (Nat.log 2 N + 1) ≤ N) (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hW : ∀ P ∈ W, InExteriorCorner c L R P) (hbetween : ∀ S ∈ F, ∀ u v : ℕ, u < v → ({u, v} : Finset ℕ) ∈ W → ∃ x ∈ S, u < x ∧ x < v) : F.card ≤ (((Finset.Icc 1 N).powersetCard 2) \ W).card + 20001 * N := by classical let B := F.filter (fun S => S.card ≤ 2) let G := F.filter (fun S => ¬ S.card ≤ 2) have hB : B.card ≤ N := by have hh := small_common_point_card_le (F := B) (U := Finset.Icc 1 N) (c := c) (fun S hS => Finset.mem_powerset.mp (hF.1 (Finset.mem_filter.mp hS).1)) (fun S hS => hc S (Finset.mem_filter.mp hS).1) (fun S hS => (Finset.mem_filter.mp hS).2) simpa using hh have hGF : G ⊆ F := Finset.filter_subset _ _ obtain ⟨f, hvalid, hAllowed, hinj, hmiss⟩ := exists_star_matching_outside_exterior_pairs hcL hLR hRN hN (arithInterSet_mono hF hGF) (fun S hS => hc S (hGF hS)) (fun S hS => by have hh := (Finset.mem_filter.mp hS).2; omega) hW (fun S hS => hbetween S (hGF hS)) have hG : G.card ≤ (((Finset.Icc 1 N).powersetCard 2) \ W).card + 20000 * N := by have hh := partial_matching_card_le (B := ((Finset.Icc 1 N).powersetCard 2) \ W) f (fun S P hP => Finset.mem_sdiff.mpr ⟨Finset.mem_powersetCard.mpr ⟨(hvalid S P hP).2.trans ((Finset.erase_subset _ _).trans (Finset.mem_powerset.mp (hF.1 (hGF S.property)))), (hvalid S P hP).1⟩, hAllowed S P hP⟩) hinj hmiss simpa using hh have hpartition := Finset.card_filter_add_card_filter_not (s := F) (fun S => S.card ≤ 2) change B.card + G.card = F.card at hpartition omega end section open Finset theorem arithInter_nonempty {N : ℕ} {F : Finset (Finset ℕ)} {S T : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hS : S ∈ F) (hT : T ∈ F) (hne : S ≠ T) : (S ∩ T).Nonempty := by obtain ⟨l, hl, hAP⟩ := hF.2 hS hT hne apply Finset.nonempty_iff_ne_empty.mpr intro hzero exact Set.not_isAPOfLength_empty hl (by simpa only [hzero, Finset.coe_empty] using hAP) theorem exists_exterior_interval_pairs {N c L R : ℕ} {I : Finset (Finset ℕ)} (hLR : L ≤ R) (hI : ∀ S ∈ I, ∃ a b : ℕ, c + 1 < a ∧ a ≤ L ∧ R ≤ b ∧ b < N ∧ S = Finset.Icc a b) : ∃ W : Finset (Finset ℕ), W.card = I.card ∧ W ⊆ (Finset.Icc 1 N).powersetCard 2 ∧ (∀ P ∈ W, InExteriorCorner c L R P) ∧ (∀ u v : ℕ, u < v → ({u, v} : Finset ℕ) ∈ W → ∃ T ∈ I, T = Finset.Icc (u + 1) (v - 1)) := by classical let A := {S : Finset ℕ // S ∈ I} choose a b hca haL hRb hbN hset using (fun S : A => hI S.val S.property) let f : A → Finset ℕ := fun S => {a S - 1, b S + 1} let W : Finset (Finset ℕ) := Finset.univ.image f have hlt : ∀ S : A, a S - 1 < b S + 1 := by intro S have h1 := haL S have h2 := hRb S omega have hinj : Function.Injective f := by intro S T hST have heq := sorted_pair_finset_injective (hlt S) (hlt T) hST have ha := congrArg Prod.fst heq have hb := congrArg Prod.snd heq have haST : a S = a T := by have h1 := hca S; have h2 := hca T; omega have hbST : b S = b T := by omega apply Subtype.ext rw [hset S, hset T, haST, hbST] refine ⟨W, ?_, ?_, ?_, ?_⟩ · simp only [W, Finset.card_image_of_injective _ hinj, Finset.card_univ, A, Fintype.card_coe] · intro P hP obtain ⟨S, hS, rfl⟩ := Finset.mem_image.mp hP apply Finset.mem_powersetCard.mpr refine ⟨?_, by simp [f, (hlt S).ne]⟩ intro x hx simp only [f, Finset.mem_insert, Finset.mem_singleton] at hx have h1 := hca S have h2 := haL S have h3 := hRb S have h4 := hbN S exact Finset.mem_Icc.mpr ⟨by omega, by omega⟩ · intro P hP obtain ⟨S, hS, rfl⟩ := Finset.mem_image.mp hP have h1 := hca S have h2 := haL S have h3 := hRb S exact ⟨a S - 1, b S + 1, by omega, by omega, by omega, rfl⟩ · intro u v huv hP obtain ⟨S, hS, hfS⟩ := Finset.mem_image.mp hP have heq := sorted_pair_finset_injective (hlt S) huv hfS have hu := congrArg Prod.fst heq have hv := congrArg Prod.snd heq have haeq : a S = u + 1 := by have hh := hca S; omega have hbeq : b S = v - 1 := by omega exact ⟨S.val, S.property, by rw [hset S, haeq, hbeq]⟩ def boundaryIntervals (c N : ℕ) : Finset (Finset ℕ) := ((Finset.Icc 1 N).image (fun b => Finset.Icc (c + 1) b)) ∪ ((Finset.Icc 1 N).image (fun a => Finset.Icc a N)) theorem card_boundaryIntervals_le (c N : ℕ) : (boundaryIntervals c N).card ≤ 2 * N := by have hcard := Finset.card_union_le ((Finset.Icc 1 N).image (fun b => Finset.Icc (c + 1) b)) ((Finset.Icc 1 N).image (fun a => Finset.Icc a N)) have hleft := Finset.card_image_le (s := Finset.Icc 1 N) (f := fun b => Finset.Icc (c + 1) b) have hright := Finset.card_image_le (s := Finset.Icc 1 N) (f := fun a => Finset.Icc a N) simp only [Nat.card_Icc] at hleft hright change (boundaryIntervals c N).card ≤ _ at hcard omega theorem long_core_family_card_le {N c L R : ℕ} {F : Finset (Finset ℕ)} (hcL : c < L) (hLR : L ≤ R) (hRN : R ≤ N) (hN : 256 * (L + N - R) * (Nat.log 2 N + 1) ≤ N) (hF : Erdos272.IsArithInterSet N F) (hinterval : ∀ S ∈ F, c ∉ S → ∃ a b : ℕ, c < a ∧ a ≤ L ∧ R ≤ b ∧ b ≤ N ∧ S = Finset.Icc a b) : F.card ≤ N.choose 2 + 20003 * N := by classical let H := F.filter (fun S => c ∈ S) let J := F.filter (fun S => c ∉ S) let B := J.filter (fun S => S ∈ boundaryIntervals c N) let I := J.filter (fun S => S ∉ boundaryIntervals c N) have hHF : H ⊆ F := Finset.filter_subset _ _ have hJF : J ⊆ F := Finset.filter_subset _ _ have hIJ : I ⊆ J := Finset.filter_subset _ _ have hIF : I ⊆ F := hIJ.trans hJF have hHc : ∀ S ∈ H, c ∈ S := fun S hS => (Finset.mem_filter.mp hS).2 have hJc : ∀ S ∈ J, c ∉ S := fun S hS => (Finset.mem_filter.mp hS).2 have hIgood : ∀ S ∈ I, ∃ a b : ℕ, c + 1 < a ∧ a ≤ L ∧ R ≤ b ∧ b < N ∧ S = Finset.Icc a b := by intro S hS obtain ⟨a, b, hca, haL, hRb, hbN, hSab⟩ := hinterval S (hIF hS) (hJc S (hIJ hS)) have hnot : S ∉ boundaryIntervals c N := (Finset.mem_filter.mp hS).2 have ha1 : 1 ≤ a := by omega have hb1 : 1 ≤ b := by omega have haN : a ≤ N := by omega have hane : a ≠ c + 1 := by intro heq apply hnot apply Finset.mem_union_left exact Finset.mem_image.mpr ⟨b, Finset.mem_Icc.mpr ⟨hb1, hbN⟩, by rw [hSab, heq]⟩ have hbne : b ≠ N := by intro heq apply hnot apply Finset.mem_union_right exact Finset.mem_image.mpr ⟨a, Finset.mem_Icc.mpr ⟨ha1, haN⟩, by rw [hSab, heq]⟩ exact ⟨a, b, by omega, haL, hRb, by omega, hSab⟩ obtain ⟨W, hWcard, hWsub, hWcorner, hWdecode⟩ := exists_exterior_interval_pairs hLR hIgood have hbetween : ∀ S ∈ H, ∀ u v : ℕ, u < v → ({u, v} : Finset ℕ) ∈ W → ∃ x ∈ S, u < x ∧ x < v := by intro S hS u v huv hW obtain ⟨T, hT, hTuv⟩ := hWdecode u v huv hW have hne : S ≠ T := by intro heq exact hJc T (hIJ hT) (heq ▸ hHc S hS) obtain ⟨x, hx⟩ := arithInter_nonempty hF (hHF hS) (hIF hT) hne obtain ⟨hxS, hxT⟩ := Finset.mem_inter.mp hx rw [hTuv] at hxT have hbounds := Finset.mem_Icc.mp hxT exact ⟨x, hxS, by omega, by omega⟩ have hH := star_card_le_with_reserved_pairs hcL hLR hRN hN (arithInterSet_mono hF hHF) hHc hWcorner hbetween have hB : B.card ≤ 2 * N := by have hBsub : B ⊆ boundaryIntervals c N := fun S hS => (Finset.mem_filter.mp hS).2 exact (Finset.card_le_card hBsub).trans (card_boundaryIntervals_le c N) have hpool := Finset.card_sdiff_add_card_eq_card hWsub simp only [Finset.card_powersetCard, Nat.card_Icc, Nat.add_sub_cancel] at hpool have hFpart := Finset.card_filter_add_card_filter_not (s := F) (fun S => c ∈ S) change H.card + J.card = F.card at hFpart have hJpart := Finset.card_filter_add_card_filter_not (s := J) (fun S => S ∈ boundaryIntervals c N) change B.card + I.card = J.card at hJpart omega end section open Finset def apSegment (u v d : ℕ) : Finset ℕ := (Finset.Icc u v).filter (fun x => d ∣ x - u) def apTrace (c p d : ℕ) : Finset ℕ := apSegment (min c p) (max c p) d theorem apSegment_eq_natAP {u v d : ℕ} (huv : u ≤ v) (hd : 0 < d) : apSegment u v d = natAP u d ((v - u) / d + 1) := by ext x simp only [apSegment, Finset.mem_filter, Finset.mem_Icc, mem_natAP] constructor · rintro ⟨⟨hux, hxv⟩, hdiv⟩ refine ⟨(x - u) / d, ?_, ?_⟩ · apply Nat.lt_succ_of_le exact Nat.div_le_div_right (by omega : x - u ≤ v - u) · rw [Nat.div_mul_cancel hdiv] omega · rintro ⟨i, hi, hxi⟩ have hib : i * d ≤ v - u := (Nat.le_div_iff_mul_le hd).mp (by omega) refine ⟨⟨by omega, by omega⟩, ?_⟩ refine ⟨i, ?_⟩ rw [← hxi, Nat.add_sub_cancel_left, Nat.mul_comm] theorem apSegment_isAP {u v d : ℕ} (huv : u ≤ v) (hd : 0 < d) : ∃ l : ℕ∞, (apSegment u v d : Set ℕ).IsAPOfLength l := by rw [apSegment_eq_natAP huv hd] exact ⟨((v - u) / d + 1 : ℕ), natAP_isAP hd⟩ theorem apTrace_isAP {c p d : ℕ} (hd : 0 < d) : ∃ l : ℕ∞, (apTrace c p d : Set ℕ).IsAPOfLength l := apSegment_isAP min_le_max hd theorem natAP_inter_Icc_eq_segment {a d k u v : ℕ} (hd : 0 < d) (hu : u ∈ natAP a d k) (hv : v ∈ natAP a d k) (_huv : u ≤ v) : natAP a d k ∩ Finset.Icc u v = apSegment u v d := by obtain ⟨i, hi, hui⟩ := mem_natAP.mp hu obtain ⟨j, hj, hvj⟩ := mem_natAP.mp hv ext x simp only [Finset.mem_inter, apSegment, Finset.mem_filter, Finset.mem_Icc] constructor · rintro ⟨hxA, hux, hxv⟩ obtain ⟨b, hb, hxb⟩ := mem_natAP.mp hxA refine ⟨⟨hux, hxv⟩, ?_⟩ rw [← hxb, ← hui, Nat.add_sub_add_left, ← Nat.sub_mul] exact dvd_mul_left d (b - i) · rintro ⟨⟨hux, hxv⟩, hdx⟩ obtain ⟨t, ht⟩ := hdx have hxt : x = a + (i + t) * d := by have hsub := Nat.sub_add_cancel hux nlinarith only [hui, ht, hsub] have hij : i + t ≤ j := by by_contra hle have hmul := Nat.mul_lt_mul_of_pos_right (by omega : j < i + t) hd omega exact ⟨mem_natAP.mpr ⟨i + t, hij.trans_lt hj, hxt.symm⟩, hux, hxv⟩ theorem ap_inter_Icc_endpoints {S : Finset ℕ} {u v : ℕ} (hAP : ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hu : u ∈ S) (hv : v ∈ S) (huv : u < v) : ∃ d : ℕ, 0 < d ∧ d ∣ v - u ∧ S ∩ Finset.Icc u v = apSegment u v d := by have hcard : 2 ≤ S.card := by have hsub : {u, v} ⊆ S := by simp [Finset.insert_subset_iff, hu, hv] simpa [huv.ne] using Finset.card_le_card hsub obtain ⟨l, hAP⟩ := hAP obtain ⟨a, d, hd, hS⟩ := nat_ap_eq_natAP hAP hcard have hslice := natAP_inter_Icc_eq_segment hd (hS ▸ hu) (hS ▸ hv) huv.le have hvseg : v ∈ apSegment u v d := hslice ▸ Finset.mem_inter.mpr ⟨hS ▸ hv, Finset.mem_Icc.mpr ⟨huv.le, le_rfl⟩⟩ exact ⟨d, hd, (Finset.mem_filter.mp hvseg).2, (congrArg (fun T : Finset ℕ => T ∩ Finset.Icc u v) hS).trans hslice⟩ theorem ap_inter_Icc {S : Finset ℕ} {u v : ℕ} (hAP : ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) : ∃ l : ℕ∞, ((S ∩ Finset.Icc u v : Finset ℕ) : Set ℕ).IsAPOfLength l := by let T := S ∩ Finset.Icc u v rcases T.eq_empty_or_nonempty with hzero | hT · refine ⟨0, Set.IsAPOfLength.zero.mpr ?_⟩ change (T : Set ℕ) = ∅ simp [hzero] · let a := T.min' hT let b := T.max' hT have haT : a ∈ T := Finset.min'_mem T hT have hbT : b ∈ T := Finset.max'_mem T hT have hab : a ≤ b := Finset.min'_le T b hbT by_cases heq : a = b · have hTsmall : T.card ≤ 1 := Finset.card_le_one.mpr (by intro x hx y hy have hax : a ≤ x := Finset.min'_le T x hx have hxb : x ≤ b := Finset.le_max' T x hx have hay : a ≤ y := Finset.min'_le T y hy have hyb : y ≤ b := Finset.le_max' T y hy omega) obtain ⟨l, hl, hTl⟩ := nonempty_small_isAP hT (by omega : T.card ≤ 2) exact ⟨l, hTl⟩ · obtain ⟨d, hd, hdiv, hslice⟩ := ap_inter_Icc_endpoints hAP (Finset.mem_inter.mp haT).1 (Finset.mem_inter.mp hbT).1 (by omega) have hT_eq : T = S ∩ Finset.Icc a b := by ext x constructor · intro hx exact Finset.mem_inter.mpr ⟨(Finset.mem_inter.mp hx).1, Finset.mem_Icc.mpr ⟨Finset.min'_le T x hx, Finset.le_max' T x hx⟩⟩ · intro hx obtain ⟨hxS, hxI⟩ := Finset.mem_inter.mp hx have habounds := Finset.mem_Icc.mp (Finset.mem_inter.mp haT).2 have hbbounds := Finset.mem_Icc.mp (Finset.mem_inter.mp hbT).2 have hxbounds := Finset.mem_Icc.mp hxI exact Finset.mem_inter.mpr ⟨hxS, Finset.mem_Icc.mpr ⟨by omega, by omega⟩⟩ change ∃ l : ℕ∞, (T : Set ℕ).IsAPOfLength l rw [hT_eq, hslice] exact apSegment_isAP hab hd theorem ap_trace_endpoints {S : Finset ℕ} {c p : ℕ} (hAP : ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hc : c ∈ S) (hp : p ∈ S) (hcp : c ≠ p) : ∃ d : ℕ, 0 < d ∧ d ∣ max c p - min c p ∧ S ∩ Finset.Icc (min c p) (max c p) = apTrace c p d := by have hmin : min c p ∈ S := by rcases le_total c p with h | h · simpa only [min_eq_left h] using hc · simpa only [min_eq_right h] using hp have hmax : max c p ∈ S := by rcases le_total c p with h | h · simpa only [max_eq_right h] using hp · simpa only [max_eq_left h] using hc have hlt : min c p < max c p := by omega exact ap_inter_Icc_endpoints hAP hmin hmax hlt theorem hasAPCover_inter_Icc {S T : Finset ℕ} {u v : ℕ} (hT : T ⊆ Finset.Icc u v) (hcover : HasAPCover S T) : HasAPCover (S ∩ Finset.Icc u v) T := by obtain ⟨A, hAS, hAP, hTA⟩ := hcover refine ⟨A ∩ Finset.Icc u v, ?_, ap_inter_Icc hAP, ?_⟩ · intro x hx obtain ⟨hxA, hxI⟩ := Finset.mem_inter.mp hx exact Finset.mem_inter.mpr ⟨hAS hxA, hxI⟩ · exact Finset.subset_inter hTA hT theorem witness_pair_of_inter_Icc {S P : Finset ℕ} {c u v : ℕ} (hc : c ∈ Finset.Icc u v) (hW : IsWitnessPair (S ∩ Finset.Icc u v) c P) : IsWitnessPair S c P := by refine ⟨hW.1, ?_, ?_⟩ · intro x hx obtain ⟨hxc, hxSI⟩ := Finset.mem_erase.mp (hW.2.1 hx) exact Finset.mem_erase.mpr ⟨hxc, (Finset.mem_inter.mp hxSI).1⟩ · intro hcover apply hW.2.2 apply hasAPCover_inter_Icc (Finset.insert_subset hc ?_) hcover intro x hx exact (Finset.mem_inter.mp (Finset.mem_of_mem_erase (hW.2.1 hx))).2 end section open Finset def anchorDistance (c p : ℕ) : ℕ := max c p - min c p def traceAt (S : Finset ℕ) (c p : ℕ) : Finset ℕ := S ∩ Finset.Icc (min c p) (max c p) def AllTriplesCovered (S : Finset ℕ) (c p : ℕ) : Prop := ∀ x ∈ S, HasAPCover S {c, p, x} def HasWitnessAt (S : Finset ℕ) (c p : ℕ) : Prop := ∃ x, IsWitnessPair S c {p, x} theorem anchorDistance_pos {c p : ℕ} (hcp : c ≠ p) : 0 < anchorDistance c p := by dsimp [anchorDistance] omega theorem allTriplesCovered_of_no_witnessAt {S : Finset ℕ} {c p : ℕ} (hc : c ∈ S) (hp : p ∈ S.erase c) (hno : ¬ HasWitnessAt S c p) : AllTriplesCovered S c p := by have hpne := (Finset.mem_erase.mp hp).1 have hpS := (Finset.mem_erase.mp hp).2 have hpairCover : HasAPCover S {c, p} := by obtain ⟨l, hl, hAP⟩ := nonempty_small_isAP (s := {c, p}) (by simp) (by simp [hpne.symm]) exact ⟨{c, p}, by simp [Finset.insert_subset_iff, hc, hpS], ⟨l, hAP⟩, Finset.Subset.refl _⟩ intro x hx by_cases hxc : x = c · subst x have heq : ({c, p, c} : Finset ℕ) = {c, p} := by ext z; simp [or_comm] rw [heq] exact hpairCover by_cases hxp : x = p · subst x simpa using hpairCover apply hasAPCover_of_not_witness (by simp [Ne.symm hxp]) · intro y hy simp only [Finset.mem_insert, Finset.mem_singleton] at hy rcases hy with rfl | rfl · exact hp · exact Finset.mem_erase.mpr ⟨hxc, hx⟩ · exact fun hW => hno ⟨x, hW⟩ def IncompatibleTraceCode (S : Finset ℕ) (c p d e : ℕ) : Prop := apTrace c p d ⊆ S ∧ apTrace c p e ⊆ S ∧ ¬ HasAPCover S (apTrace c p d ∪ apTrace c p e) theorem exists_incompatible_trace_code {S : Finset ℕ} {c p : ℕ} (hc : c ∈ S) (hcp : c ≠ p) (hcover : AllTriplesCovered S c p) (hcrooked : IsCrooked (traceAt S c p)) : ∃ d e : ℕ, 0 < d ∧ 0 < e ∧ d ∣ anchorDistance c p ∧ e ∣ anchorDistance c p ∧ IncompatibleTraceCode S c p d e := by have hcI : c ∈ Finset.Icc (min c p) (max c p) := Finset.mem_Icc.mpr ⟨min_le_left _ _, le_max_left _ _⟩ have hcT : c ∈ traceAt S c p := Finset.mem_inter.mpr ⟨hc, hcI⟩ obtain ⟨P, hP⟩ := exists_witness_pair hcrooked hcT obtain ⟨x, y, hxy, rfl⟩ := Finset.card_eq_two.mp hP.1 have hPS : IsWitnessPair S c {x, y} := witness_pair_of_inter_Icc hcI hP have hxT : x ∈ traceAt S c p := Finset.mem_of_mem_erase (hP.2.1 (by simp)) have hyT : y ∈ traceAt S c p := Finset.mem_of_mem_erase (hP.2.1 (by simp)) obtain ⟨A, hAS, hAAP, hAx⟩ := hcover x (Finset.mem_inter.mp hxT).1 obtain ⟨B, hBS, hBAP, hBy⟩ := hcover y (Finset.mem_inter.mp hyT).1 obtain ⟨d, hd, hddiv, hAtrace⟩ := ap_trace_endpoints hAAP (hAx (by simp)) (hAx (by simp)) hcp obtain ⟨e, he, hediv, hBtrace⟩ := ap_trace_endpoints hBAP (hBy (by simp)) (hBy (by simp)) hcp have hTdS : apTrace c p d ⊆ S := by rw [← hAtrace] exact Finset.inter_subset_left.trans hAS have hTeS : apTrace c p e ⊆ S := by rw [← hBtrace] exact Finset.inter_subset_left.trans hBS have hcTd : c ∈ apTrace c p d := hAtrace ▸ Finset.mem_inter.mpr ⟨hAx (by simp), hcI⟩ have hxTd : x ∈ apTrace c p d := hAtrace ▸ Finset.mem_inter.mpr ⟨hAx (by simp), (Finset.mem_inter.mp hxT).2⟩ have hyTe : y ∈ apTrace c p e := hBtrace ▸ Finset.mem_inter.mpr ⟨hBy (by simp), (Finset.mem_inter.mp hyT).2⟩ refine ⟨d, e, hd, he, hddiv, hediv, hTdS, hTeS, ?_⟩ rintro ⟨C, hCS, hCAP, hUC⟩ apply hPS.2.2 refine ⟨C, hCS, hCAP, ?_⟩ have hcC := hUC (Finset.mem_union_left _ hcTd) have hxC := hUC (Finset.mem_union_left _ hxTd) have hyC := hUC (Finset.mem_union_right _ hyTe) simp [Finset.insert_subset_iff, hcC, hxC, hyC] theorem trace_code_private {N c p d e : ℕ} {F : Finset (Finset ℕ)} {S T : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hS : S ∈ F) (hT : T ∈ F) (hcode : IncompatibleTraceCode S c p d e) (hTd : apTrace c p d ⊆ T) (hTe : apTrace c p e ⊆ T) : T = S := by by_contra hne obtain ⟨l, hl, hAP⟩ := hF.2 hS hT (fun hST => hne hST.symm) apply hcode.2.2 refine ⟨S ∩ T, Finset.inter_subset_left, ⟨l, hAP⟩, ?_⟩ exact Finset.subset_inter (Finset.union_subset hcode.1 hcode.2.1) (Finset.union_subset hTd hTe) theorem crooked_trace_family_card_le {N c : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (p : {S // S ∈ F} → ℕ) (hp : ∀ S, p S ∈ S.val ∧ c ≠ p S) (hcover : ∀ S, AllTriplesCovered S.val c (p S)) (hcrooked : ∀ S, IsCrooked (traceAt S.val c (p S))) : F.card ≤ ∑ q ∈ Finset.Icc 1 N, ((anchorDistance c q).divisors.card)^2 := by classical let A := {S : Finset ℕ // S ∈ F} have hex : ∀ S : A, ∃ d e : ℕ, 0 < d ∧ 0 < e ∧ d ∣ anchorDistance c (p S) ∧ e ∣ anchorDistance c (p S) ∧ IncompatibleTraceCode S.val c (p S) d e := by intro S exact exists_incompatible_trace_code (hc S.val S.property) (hp S).2 (hcover S) (hcrooked S) choose d e hd he hddiv hediv hcode using hex let U : Finset (Σ _ : ℕ, ℕ × ℕ) := (Finset.Icc 1 N).sigma (fun q => ((anchorDistance c q).divisors).product ((anchorDistance c q).divisors)) let f : A → (Σ _ : ℕ, ℕ × ℕ) := fun S => ⟨p S, d S, e S⟩ have hmaps : Set.MapsTo f ((Finset.univ : Finset A) : Set A) (U : Set (Σ _ : ℕ, ℕ × ℕ)) := by intro S hS have hpI : p S ∈ Finset.Icc 1 N := Finset.mem_powerset.mp (hF.1 S.property) (hp S).1 have hdist : anchorDistance c (p S) ≠ 0 := (anchorDistance_pos (hp S).2).ne' exact Finset.mem_sigma.mpr ⟨hpI, Finset.mem_product.mpr ⟨Nat.mem_divisors.mpr ⟨hddiv S, hdist⟩, Nat.mem_divisors.mpr ⟨hediv S, hdist⟩⟩⟩ have hinj : Function.Injective f := by intro S T hf have hpST : p S = p T := congrArg Sigma.fst hf have hdST : d S = d T := congrArg (fun q : (Σ _ : ℕ, ℕ × ℕ) => q.2.1) hf have heST : e S = e T := congrArg (fun q : (Σ _ : ℕ, ℕ × ℕ) => q.2.2) hf apply Subtype.ext exact (trace_code_private hF S.property T.property (hcode S) (by simpa only [hpST, hdST] using (hcode T).1) (by simpa only [hpST, heST] using (hcode T).2.1)).symm have hcard := Finset.card_le_card_of_injOn f hmaps hinj.injOn simpa [A, U, Finset.card_sigma, Finset.card_product, pow_two] using hcard end section open Finset theorem natAP_dvd_anchorDistance {a d k c x : ℕ} (hc : c ∈ natAP a d k) (hx : x ∈ natAP a d k) : d ∣ anchorDistance c x := by obtain ⟨i, hi, hci⟩ := mem_natAP.mp hc obtain ⟨j, hj, hxj⟩ := mem_natAP.mp hx rcases le_total c x with hcx | hxc · rw [anchorDistance, min_eq_left hcx, max_eq_right hcx, ← hxj, ← hci, Nat.add_sub_add_left, ← Nat.sub_mul] exact dvd_mul_left d (j - i) · rw [anchorDistance, min_eq_right hxc, max_eq_left hxc, ← hci, ← hxj, Nat.add_sub_add_left, ← Nat.sub_mul] exact dvd_mul_left d (i - j) theorem apTrace_step_dvd_of_subset {c p d e : ℕ} (hcp : c ≠ p) (hediv : e ∣ anchorDistance c p) (hsub : apTrace c p e ⊆ apTrace c p d) : d ∣ e := by have heD : e ≤ anchorDistance c p := Nat.le_of_dvd (anchorDistance_pos hcp) hediv have hpoint : min c p + e ∈ apTrace c p e := by apply Finset.mem_filter.mpr refine ⟨Finset.mem_Icc.mpr ⟨by omega, ?_⟩, ?_⟩ · dsimp [anchorDistance] at heD omega · simp have hh := (Finset.mem_filter.mp (hsub hpoint)).2 simpa only [Nat.add_sub_cancel_left] using hh theorem natAP_consecutive {a d k i : ℕ} (hd : 0 < d) (hi : i + 1 < k) : ConsecutiveIn (natAP a d k) (a + i * d) (a + (i + 1) * d) := by refine ⟨mem_natAP.mpr ⟨i, by omega, rfl⟩, mem_natAP.mpr ⟨i + 1, hi, rfl⟩, by nlinarith only [hd], ?_⟩ intro x hx hbetween obtain ⟨j, hj, hxj⟩ := mem_natAP.mp hx have hij : i < j := by by_contra hh have hmul := Nat.mul_le_mul_right d (by omega : j ≤ i) omega have hji : j < i + 1 := by by_contra hh have hmul := Nat.mul_le_mul_right d (by omega : i + 1 ≤ j) omega omega theorem consecutive_of_inter_Icc {S : Finset ℕ} {u v a b : ℕ} (hcon : ConsecutiveIn (S ∩ Finset.Icc u v) a b) : ConsecutiveIn S a b := by have ha := Finset.mem_inter.mp hcon.1 have hb := Finset.mem_inter.mp hcon.2.1 refine ⟨ha.1, hb.1, hcon.2.2.1, ?_⟩ intro x hx hbetween apply hcon.2.2.2 x (Finset.mem_inter.mpr ⟨hx, ?_⟩) hbetween have haI := Finset.mem_Icc.mp ha.2 have hbI := Finset.mem_Icc.mp hb.2 exact Finset.mem_Icc.mpr ⟨by omega, by omega⟩ theorem apTrace_neighbor {S : Finset ℕ} {c p d : ℕ} (hcp : c ≠ p) (hd : 0 < d) (hddiv : d ∣ anchorDistance c p) (htrace : traceAt S c p = apTrace c p d) : ∃ a : ℕ, (ConsecutiveIn S c a ∨ ConsecutiveIn S a c) ∧ anchorDistance c a = d := by let u := min c p let v := max c p let q := (v - u) / d have hDpos : 0 < v - u := anchorDistance_pos hcp have hqd : q * d = v - u := Nat.div_mul_cancel hddiv have hq : 1 ≤ q := by by_contra hlt have hq0 : q = 0 := Nat.eq_zero_of_not_pos hlt rw [hq0, zero_mul] at hqd omega have hvq : v = u + q * d := by omega have hrep : traceAt S c p = natAP u d (q + 1) := by rw [htrace] exact apSegment_eq_natAP min_le_max hd rcases le_total c p with hcp' | hpc · have hu : u = c := min_eq_left hcp' have hcon : ConsecutiveIn S c (c + d) := by apply consecutive_of_inter_Icc (u := min c p) (v := max c p) change ConsecutiveIn (traceAt S c p) c (c + d) rw [hrep, hu] simpa only [zero_mul, zero_add, add_zero, one_mul] using (natAP_consecutive (a := c) (d := d) (k := q + 1) (i := 0) hd (by omega)) refine ⟨c + d, Or.inl hcon, ?_⟩ dsimp [anchorDistance] omega · have hv : v = c := max_eq_left hpc let a := u + (q - 1) * d have had : a + d = c := by have hh : q - 1 + 1 = q := by omega dsimp [a] nlinarith only [hvq, hv, hh] have hcon : ConsecutiveIn S a c := by apply consecutive_of_inter_Icc (u := min c p) (v := max c p) change ConsecutiveIn (traceAt S c p) a c rw [hrep] have hh := natAP_consecutive (a := u) (d := d) (k := q + 1) (i := q - 1) hd (by omega) have heq : u + (q - 1 + 1) * d = c := by rw [show q - 1 + 1 = q by omega, ← hvq, hv] simpa only [heq] using hh refine ⟨a, Or.inr hcon, ?_⟩ dsimp [anchorDistance] omega theorem allTriplesCovered_grid_of_APtrace {S : Finset ℕ} {c p : ℕ} (hc : c ∈ S) (hp : p ∈ S) (hcp : c ≠ p) (hcover : AllTriplesCovered S c p) (hTAP : ∃ l : ℕ∞, (traceAt S c p : Set ℕ).IsAPOfLength l) : ∃ d : ℕ, 0 < d ∧ d ∣ anchorDistance c p ∧ traceAt S c p = apTrace c p d ∧ ∀ x ∈ S, d ∣ anchorDistance c x := by let I := Finset.Icc (min c p) (max c p) have hcI : c ∈ I := Finset.mem_Icc.mpr ⟨min_le_left _ _, le_max_left _ _⟩ have hpI : p ∈ I := Finset.mem_Icc.mpr ⟨min_le_right _ _, le_max_right _ _⟩ have hcT : c ∈ traceAt S c p := Finset.mem_inter.mpr ⟨hc, hcI⟩ have hpT : p ∈ traceAt S c p := Finset.mem_inter.mpr ⟨hp, hpI⟩ obtain ⟨d, hd, hddiv, htrace⟩ := ap_trace_endpoints hTAP hcT hpT hcp have hTI : traceAt S c p ∩ I = traceAt S c p := Finset.inter_eq_left.mpr Finset.inter_subset_right have hT_eq : traceAt S c p = apTrace c p d := hTI.symm.trans htrace refine ⟨d, hd, hddiv, hT_eq, ?_⟩ intro x hx obtain ⟨A, hAS, ⟨l, hAP⟩, hCA⟩ := hcover x hx have hcA : c ∈ A := hCA (by simp) have hpA : p ∈ A := hCA (by simp) have hxA : x ∈ A := hCA (by simp) have hAcard : 2 ≤ A.card := by have hsub : {c, p} ⊆ A := by simp [Finset.insert_subset_iff, hcA, hpA] simpa [hcp] using Finset.card_le_card hsub obtain ⟨a, e, he, hArep⟩ := nat_ap_eq_natAP hAP hAcard have hediv : e ∣ anchorDistance c p := natAP_dvd_anchorDistance (hArep ▸ hcA) (hArep ▸ hpA) have hminA : min c p ∈ A := by rcases le_total c p with h | h · simpa only [min_eq_left h] using hcA · simpa only [min_eq_right h] using hpA have hmaxA : max c p ∈ A := by rcases le_total c p with h | h · simpa only [max_eq_right h] using hpA · simpa only [max_eq_left h] using hcA have hAslice : A ∩ I = apTrace c p e := (congrArg (fun T : Finset ℕ => T ∩ I) hArep).trans (natAP_inter_Icc_eq_segment he (hArep ▸ hminA) (hArep ▸ hmaxA) min_le_max) have hsubTrace : apTrace c p e ⊆ apTrace c p d := by rw [← hAslice, ← hT_eq] intro y hy obtain ⟨hyA, hyI⟩ := Finset.mem_inter.mp hy exact Finset.mem_inter.mpr ⟨hAS hyA, hyI⟩ exact (apTrace_step_dvd_of_subset hcp hediv hsubTrace).trans (natAP_dvd_anchorDistance (hArep ▸ hcA) (hArep ▸ hxA)) theorem APtrace_witness_divisor_code {S : Finset ℕ} {c p : ℕ} (hcrooked : IsCrooked S) (hc : c ∈ S) (hp : p ∈ S) (hcp : c ≠ p) (hcover : AllTriplesCovered S c p) (hTAP : ∃ l : ℕ∞, (traceAt S c p : Set ℕ).IsAPOfLength l) : ∃ a z : ℕ, IsWitnessPair S c {a, z} ∧ anchorDistance c a ∣ anchorDistance c z := by obtain ⟨d, hd, hddiv, htrace, hgrid⟩ := allTriplesCovered_grid_of_APtrace hc hp hcp hcover hTAP obtain ⟨a, hcon, had⟩ := apTrace_neighbor hcp hd hddiv htrace obtain ⟨z, hW⟩ : ∃ z, IsWitnessPair S c {a, z} := by rcases hcon with hcon | hcon · exact witness_pair_of_right_neighbor hcrooked hcon · exact witness_pair_of_left_neighbor hcrooked hcon have hzS : z ∈ S := Finset.mem_of_mem_erase (hW.2.1 (by simp)) exact ⟨a, z, hW, by simpa only [had] using hgrid z hzS⟩ end section open Finset theorem anchorDistance_inj_of_side {c a b : ℕ} (hdist : anchorDistance c a = anchorDistance c b) (hside : decide (c ≤ a) = decide (c ≤ b)) : a = b := by dsimp [anchorDistance] at hdist by_cases hca : c ≤ a · have hcb : c ≤ b := by by_contra hh; simp [hca, hh] at hside rw [max_eq_right hca, min_eq_left hca, max_eq_right hcb, min_eq_left hcb] at hdist omega · have hcb : ¬ c ≤ b := by intro hh; simp [hca, hh] at hside have hac : a ≤ c := by omega have hbc : b ≤ c := by omega rw [max_eq_left hac, min_eq_right hac, max_eq_left hbc, min_eq_right hbc] at hdist omega theorem APtrace_family_card_le {N c : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hcrooked : ∀ S ∈ F, IsCrooked S) (p : {S // S ∈ F} → ℕ) (hp : ∀ S, p S ∈ S.val ∧ c ≠ p S) (hcover : ∀ S, AllTriplesCovered S.val c (p S)) (hAP : ∀ S, ∃ l : ℕ∞, (traceAt S.val c (p S) : Set ℕ).IsAPOfLength l) : F.card ≤ 2 * ∑ q ∈ Finset.Icc 1 N, (anchorDistance c q).divisors.card := by classical let A := {S : Finset ℕ // S ∈ F} have hex : ∀ S : A, ∃ a z : ℕ, IsWitnessPair S.val c {a, z} ∧ anchorDistance c a ∣ anchorDistance c z := by intro S exact APtrace_witness_divisor_code (hcrooked S.val S.property) (hc S.val S.property) (hp S).1 (hp S).2 (hcover S) (hAP S) choose a z hW hdiv using hex let U : Finset (Σ _ : ℕ, Bool × ℕ) := (Finset.Icc 1 N).sigma (fun q => (Finset.univ : Finset Bool).product (anchorDistance c q).divisors) let f : A → (Σ _ : ℕ, Bool × ℕ) := fun S => ⟨z S, decide (c ≤ a S), anchorDistance c (a S)⟩ have hmaps : Set.MapsTo f ((Finset.univ : Finset A) : Set A) (U : Set (Σ _ : ℕ, Bool × ℕ)) := by intro S hS have hz : z S ∈ S.val.erase c := (hW S).2.1 (by simp) have hzI : z S ∈ Finset.Icc 1 N := Finset.mem_powerset.mp (hF.1 S.property) (Finset.mem_of_mem_erase hz) have hdist : anchorDistance c (z S) ≠ 0 := (anchorDistance_pos (Ne.symm (Finset.mem_erase.mp hz).1)).ne' exact Finset.mem_sigma.mpr ⟨hzI, Finset.mem_product.mpr ⟨Finset.mem_univ _, Nat.mem_divisors.mpr ⟨hdiv S, hdist⟩⟩⟩ have hinj : Function.Injective f := by intro S T hf have hz : z S = z T := congrArg Sigma.fst hf have hside : decide (c ≤ a S) = decide (c ≤ a T) := congrArg (fun q : (Σ _ : ℕ, Bool × ℕ) => q.2.1) hf have hdist : anchorDistance c (a S) = anchorDistance c (a T) := congrArg (fun q : (Σ _ : ℕ, Bool × ℕ) => q.2.2) hf have ha : a S = a T := anchorDistance_inj_of_side hdist hside apply Subtype.ext exact (witness_pair_private hF S.property T.property (hc S.val S.property) (hc T.val T.property) (hW S) (by rw [ha, hz] exact (hW T).2.1.trans (Finset.erase_subset _ _))).symm have hcard := Finset.card_le_card_of_injOn f hmaps hinj.injOn simpa [A, U, Finset.card_sigma, Finset.card_product, Finset.mul_sum] using hcard end section open Finset def witnessExceptionBound (N c : ℕ) : ℕ := (∑ q ∈ Finset.Icc 1 N, ((anchorDistance c q).divisors.card)^2) + 2 * ∑ q ∈ Finset.Icc 1 N, (anchorDistance c q).divisors.card theorem noWitnessAt_family_card_le {N c : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hcrooked : ∀ S ∈ F, IsCrooked S) (p : Finset ℕ → ℕ) (hp : ∀ S ∈ F, p S ∈ S.erase c) (hno : ∀ S ∈ F, ¬ HasWitnessAt S c (p S)) : F.card ≤ witnessExceptionBound N c := by classical let C := F.filter (fun S => IsCrooked (traceAt S c (p S))) let A := F.filter (fun S => ¬ IsCrooked (traceAt S c (p S))) have hCF : C ⊆ F := Finset.filter_subset _ _ have hAF : A ⊆ F := Finset.filter_subset _ _ have hcover : ∀ S ∈ F, AllTriplesCovered S c (p S) := fun S hS => allTriplesCovered_of_no_witnessAt (hc S hS) (hp S hS) (hno S hS) have hC := crooked_trace_family_card_le (arithInterSet_mono hF hCF) (fun S hS => hc S (hCF hS)) (fun S => p S.val) (fun S => ⟨Finset.mem_of_mem_erase (hp S.val (hCF S.property)), Ne.symm (Finset.mem_erase.mp (hp S.val (hCF S.property))).1⟩) (fun S => hcover S.val (hCF S.property)) (fun S => (Finset.mem_filter.mp S.property).2) have hA := APtrace_family_card_le (arithInterSet_mono hF hAF) (fun S hS => hc S (hAF hS)) (fun S hS => hcrooked S (hAF hS)) (fun S => p S.val) (fun S => ⟨Finset.mem_of_mem_erase (hp S.val (hAF S.property)), Ne.symm (Finset.mem_erase.mp (hp S.val (hAF S.property))).1⟩) (fun S => hcover S.val (hAF S.property)) (fun S => by simpa only [IsCrooked, not_not] using (Finset.mem_filter.mp S.property).2) have hpartition := Finset.card_filter_add_card_filter_not (s := F) (fun S => IsCrooked (traceAt S c (p S))) change C.card + A.card = F.card at hpartition dsimp [witnessExceptionBound] omega theorem restricted_witness_bad_family_card_le {N c : ℕ} {F : Finset (Finset ℕ)} {P : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hcrooked : ∀ S ∈ F, IsCrooked S) (hmet : ∀ S ∈ F, (S.erase c ∩ P).Nonempty) (hbad : ∀ S ∈ F, ∀ Q, IsWitnessPair S c Q → Disjoint Q P) : F.card ≤ witnessExceptionBound N c := by classical have hex : ∀ S : {S // S ∈ F}, ∃ p, p ∈ S.val.erase c ∩ P := fun S => hmet S.val S.property choose p₀ hp₀ using hex let p : Finset ℕ → ℕ := fun S => if h : S ∈ F then p₀ ⟨S, h⟩ else 0 have hp : ∀ S ∈ F, p S ∈ S.erase c ∩ P := by intro S hS simpa only [p, dif_pos hS] using hp₀ ⟨S, hS⟩ apply noWitnessAt_family_card_le hF hc hcrooked p (fun S hS => (Finset.mem_inter.mp (hp S hS)).1) intro S hS hW obtain ⟨x, hx⟩ := hW exact Finset.disjoint_left.mp (hbad S hS {p S, x} hx) (by simp) (Finset.mem_inter.mp (hp S hS)).2 def meetingPairPool (N c : ℕ) (P : Finset ℕ) : Finset (Finset ℕ) := (((Finset.Icc 1 N).erase c).powersetCard 2).filter (fun Q => ¬ Disjoint Q P) theorem witness_meeting_family_card_le {N c : ℕ} {F : Finset (Finset ℕ)} {P : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hgood : ∀ S ∈ F, ∃ Q, IsWitnessPair S c Q ∧ ¬ Disjoint Q P) : F.card ≤ (meetingPairPool N c P).card := by classical let A := {S : Finset ℕ // S ∈ F} have hex : ∀ S : A, ∃ Q, IsWitnessPair S.val c Q ∧ ¬ Disjoint Q P := fun S => hgood S.val S.property choose Q hW hQP using hex have hmaps : Set.MapsTo Q ((Finset.univ : Finset A) : Set A) (meetingPairPool N c P : Set (Finset ℕ)) := by intro S hS refine Finset.mem_filter.mpr ⟨Finset.mem_powersetCard.mpr ⟨?_, (hW S).1⟩, hQP S⟩ intro x hx obtain ⟨hxc, hxS⟩ := Finset.mem_erase.mp ((hW S).2.1 hx) exact Finset.mem_erase.mpr ⟨hxc, Finset.mem_powerset.mp (hF.1 S.property) hxS⟩ have hinj : Function.Injective Q := by intro S T hQ apply Subtype.ext exact (witness_pair_private hF S.property T.property (hc S.val S.property) (hc T.val T.property) (hW S) (by rw [hQ] exact (hW T).2.1.trans (Finset.erase_subset _ _))).symm simpa only [Finset.card_univ, A, Fintype.card_coe] using Finset.card_le_card_of_injOn Q hmaps hinj.injOn theorem crooked_meeting_set_card_le {N c : ℕ} {F : Finset (Finset ℕ)} {P : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hcrooked : ∀ S ∈ F, IsCrooked S) (hmet : ∀ S ∈ F, (S.erase c ∩ P).Nonempty) : F.card ≤ (meetingPairPool N c P).card + witnessExceptionBound N c := by classical let G := F.filter (fun S => ∃ Q, IsWitnessPair S c Q ∧ ¬ Disjoint Q P) let B := F.filter (fun S => ¬ ∃ Q, IsWitnessPair S c Q ∧ ¬ Disjoint Q P) have hGF : G ⊆ F := Finset.filter_subset _ _ have hBF : B ⊆ F := Finset.filter_subset _ _ have hG := witness_meeting_family_card_le (arithInterSet_mono hF hGF) (fun S hS => hc S (hGF hS)) (fun S hS => (Finset.mem_filter.mp hS).2) have hB := restricted_witness_bad_family_card_le (arithInterSet_mono hF hBF) (fun S hS => hc S (hBF hS)) (fun S hS => hcrooked S (hBF hS)) (fun S hS => hmet S (hBF hS)) (fun S hS Q hQ => by by_contra hdis exact (Finset.mem_filter.mp hS).2 ⟨Q, hQ, hdis⟩) have hpartition := Finset.card_filter_add_card_filter_not (s := F) (fun S => ∃ Q, IsWitnessPair S c Q ∧ ¬ Disjoint Q P) change G.card + B.card = F.card at hpartition omega end section open Finset noncomputable def reciprocalSum (N : ℕ) : ℝ := ∑ a ∈ Finset.Icc 1 N, (a : ℝ)⁻¹ def factorQuadPool (N : ℕ) : Finset (Σ _ : ℕ, Σ _ : ℕ, Σ _ : ℕ, ℕ) := (Finset.Icc 1 N).sigma (fun g => (Finset.Icc 1 N).sigma (fun a => (Finset.Icc 1 N).sigma (fun b => Finset.Icc 1 (N / (g * a * b))))) theorem exists_divisor_pair_factors {n d e : ℕ} (hn : 0 < n) (hd : d ∈ n.divisors) (he : e ∈ n.divisors) : ∃ g a b t : ℕ, 0 < g ∧ 0 < a ∧ 0 < b ∧ 0 < t ∧ d = g * a ∧ e = g * b ∧ n = g * a * b * t := by have hdpos := Nat.pos_of_mem_divisors hd have hepos := Nat.pos_of_mem_divisors he let g := Nat.gcd d e have hg : 0 < g := Nat.gcd_pos_of_pos_left e hdpos obtain ⟨a, b, hab, hda, heb⟩ := Nat.exists_coprime d e have hD : d = g * a := by simpa only [Nat.mul_comm, g] using hda have hE : e = g * b := by simpa only [Nat.mul_comm, g] using heb have ha : 0 < a := Nat.pos_of_mul_pos_left (hD ▸ hdpos) have hb : 0 < b := Nat.pos_of_mul_pos_left (hE ▸ hepos) have hlcm : Nat.lcm d e = g * a * b := by rw [hD, hE, Nat.lcm_mul_left, hab.lcm_eq_mul, Nat.mul_assoc] have hdiv : g * a * b ∣ n := hlcm ▸ Nat.lcm_dvd (Nat.mem_divisors.mp hd).1 (Nat.mem_divisors.mp he).1 obtain ⟨t, ht⟩ := hdiv have htpos : 0 < t := by by_contra hh have ht0 : t = 0 := Nat.eq_zero_of_not_pos hh simp [ht0] at ht omega exact ⟨g, a, b, t, hg, ha, hb, htpos, hD, hE, ht⟩ theorem divisor_second_moment_le_factorQuadPool (N : ℕ) : (∑ n ∈ Finset.Icc 1 N, n.divisors.card ^ 2) ≤ (factorQuadPool N).card := by classical let U : Finset (Σ _ : ℕ, ℕ × ℕ) := (Finset.Icc 1 N).sigma (fun n => n.divisors.product n.divisors) let A := {u // u ∈ U} have hex : ∀ u : A, ∃ g a b t : ℕ, 0 < g ∧ 0 < a ∧ 0 < b ∧ 0 < t ∧ u.val.2.1 = g * a ∧ u.val.2.2 = g * b ∧ u.val.1 = g * a * b * t := by intro u obtain ⟨hn, hde⟩ := Finset.mem_sigma.mp u.property obtain ⟨hd, he⟩ := Finset.mem_product.mp hde exact exists_divisor_pair_factors (Finset.mem_Icc.mp hn).1 hd he choose g a b t hg ha hb ht hd he hn using hex let f : A → (Σ _ : ℕ, Σ _ : ℕ, Σ _ : ℕ, ℕ) := fun u => ⟨g u, a u, b u, t u⟩ have hmaps : Set.MapsTo f ((Finset.univ : Finset A) : Set A) (factorQuadPool N : Set (Σ _ : ℕ, Σ _ : ℕ, Σ _ : ℕ, ℕ)) := by intro u hu have hnN : u.val.1 ≤ N := (Finset.mem_Icc.mp (Finset.mem_sigma.mp u.property).1).2 have hprod : g u * a u * b u * t u ≤ N := by rwa [← hn u] have hga : g u * a u ≤ g u * a u * b u := Nat.le_mul_of_pos_right _ (hb u) have hgab : g u * a u * b u ≤ g u * a u * b u * t u := Nat.le_mul_of_pos_right _ (ht u) have hgN : g u ≤ N := (Nat.le_mul_of_pos_right _ (ha u)).trans (hga.trans (hgab.trans hprod)) have haN : a u ≤ N := (Nat.le_mul_of_pos_left _ (hg u)).trans (hga.trans (hgab.trans hprod)) have hbN : b u ≤ N := (Nat.le_mul_of_pos_left _ (Nat.mul_pos (hg u) (ha u))).trans (hgab.trans hprod) have hden : 0 < g u * a u * b u := Nat.mul_pos (Nat.mul_pos (hg u) (ha u)) (hb u) refine Finset.mem_sigma.mpr ⟨Finset.mem_Icc.mpr ⟨hg u, hgN⟩, ?_⟩ refine Finset.mem_sigma.mpr ⟨Finset.mem_Icc.mpr ⟨ha u, haN⟩, ?_⟩ refine Finset.mem_sigma.mpr ⟨Finset.mem_Icc.mpr ⟨hb u, hbN⟩, ?_⟩ exact Finset.mem_Icc.mpr ⟨ht u, (Nat.le_div_iff_mul_le hden).mpr (by simpa only [f, Nat.mul_comm (t u)] using hprod)⟩ let decode : (Σ _ : ℕ, Σ _ : ℕ, Σ _ : ℕ, ℕ) → (Σ _ : ℕ, ℕ × ℕ) := fun q => ⟨q.1 * q.2.1 * q.2.2.1 * q.2.2.2, q.1 * q.2.1, q.1 * q.2.2.1⟩ have hrec : ∀ u : A, decode (f u) = u.val := by intro u dsimp only [decode, f] rw [← hn u, ← hd u, ← he u] have hinj : Function.Injective f := by intro u v huv apply Subtype.ext rw [← hrec u, ← hrec v, huv] simpa [A, U, Finset.card_sigma, Finset.card_product, pow_two] using Finset.card_le_card_of_injOn f hmaps hinj.injOn theorem factorQuadPool_card_le (N : ℕ) : ((factorQuadPool N).card : ℝ) ≤ (N : ℝ) * reciprocalSum N ^ 3 := by calc ((factorQuadPool N).card : ℝ) = ∑ g ∈ Finset.Icc 1 N, ∑ a ∈ Finset.Icc 1 N, ∑ b ∈ Finset.Icc 1 N, ((N / (g * a * b) : ℕ) : ℝ) := by simp [factorQuadPool, Finset.card_sigma, Nat.cast_sum] _ ≤ ∑ g ∈ Finset.Icc 1 N, ∑ a ∈ Finset.Icc 1 N, ∑ b ∈ Finset.Icc 1 N, (N : ℝ) * (g : ℝ)⁻¹ * (a : ℝ)⁻¹ * (b : ℝ)⁻¹ := by apply Finset.sum_le_sum intro g hg apply Finset.sum_le_sum intro a ha apply Finset.sum_le_sum intro b hb simpa [Nat.cast_mul, div_eq_mul_inv, mul_inv_rev, mul_assoc, mul_left_comm, mul_comm] using (Nat.cast_div_le (α := ℝ) (m := N) (n := g * a * b)) _ = (N : ℝ) * reciprocalSum N ^ 3 := by simp only [← Finset.mul_sum, ← Finset.sum_mul, reciprocalSum] ring theorem divisor_second_moment_le_reciprocalSum (N : ℕ) : (∑ n ∈ Finset.Icc 1 N, (n.divisors.card : ℝ)^2) ≤ (N : ℝ) * reciprocalSum N ^ 3 := by have h : ((∑ n ∈ Finset.Icc 1 N, n.divisors.card ^ 2 : ℕ) : ℝ) ≤ ((factorQuadPool N).card : ℝ) := by exact_mod_cast divisor_second_moment_le_factorQuadPool N simpa only [Nat.cast_sum, Nat.cast_pow] using h.trans (factorQuadPool_card_le N) end section open Finset theorem reciprocalSum_eq_harmonic (N : ℕ) : reciprocalSum N = (harmonic N : ℝ) := by simp only [reciprocalSum, harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast] theorem reciprocalSum_nonneg (N : ℕ) : 0 ≤ reciprocalSum N := Finset.sum_nonneg (fun a _ha => inv_nonneg.mpr (Nat.cast_nonneg a)) theorem reciprocalSum_le_log (N : ℕ) : reciprocalSum N ≤ 1 + Real.log N := by rw [reciprocalSum_eq_harmonic] exact harmonic_le_one_add_log N theorem reciprocalSum_le_natLog (N : ℕ) : reciprocalSum N ≤ 2 * ((Nat.log 2 N : ℝ) + 1) := by by_cases hN : N = 0 · simp [hN, reciprocalSum] have hNpos : (0 : ℝ) < N := Nat.cast_pos.mpr (Nat.pos_of_ne_zero hN) have hpow : (N : ℝ) < (2 : ℝ) ^ (Nat.log 2 N + 1) := by exact_mod_cast Nat.lt_pow_succ_log_self (b := 2) (by decide) N have hlog := Real.log_le_log hNpos hpow.le rw [Real.log_pow] at hlog have htwo : Real.log 2 ≤ (1 : ℝ) := by have hh := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) norm_num at hh ⊢ exact hh have hmul := mul_le_mul_of_nonneg_left htwo (Nat.cast_nonneg (Nat.log 2 N + 1) : (0 : ℝ) ≤ (Nat.log 2 N + 1 : ℕ)) have hH := reciprocalSum_le_log N push_cast at hlog hmul nlinarith only [hH, hlog, hmul, Nat.cast_nonneg (α := ℝ) (Nat.log 2 N)] theorem anchorDistance_le_of_mem {N c q : ℕ} (hc : c ∈ Finset.Icc 1 N) (hq : q ∈ Finset.Icc 1 N) : anchorDistance c q ≤ N := by have hcc := Finset.mem_Icc.mp hc have hqq := Finset.mem_Icc.mp hq dsimp [anchorDistance] omega theorem sum_anchorDistance_le_twice {N c : ℕ} (hc : c ∈ Finset.Icc 1 N) (f : ℕ → ℕ) (hzero : f 0 = 0) : (∑ q ∈ Finset.Icc 1 N, f (anchorDistance c q)) ≤ 2 * ∑ m ∈ Finset.Icc 1 N, f m := by classical let U := (Finset.Icc 1 N).erase c let V := (Finset.Icc 1 N).product (Finset.univ : Finset Bool) let g : ℕ → ℕ × Bool := fun q => (anchorDistance c q, decide (c ≤ q)) have hmaps : U.image g ⊆ V := by intro z hz obtain ⟨q, hq, rfl⟩ := Finset.mem_image.mp hz obtain ⟨hqc, hqI⟩ := Finset.mem_erase.mp hq exact Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨anchorDistance_pos (Ne.symm hqc), anchorDistance_le_of_mem hc hqI⟩, Finset.mem_univ _⟩ have hinj : Set.InjOn g (U : Set ℕ) := by intro q hq r hr hqr exact anchorDistance_inj_of_side (congrArg Prod.fst hqr) (congrArg Prod.snd hqr) have hsum : (∑ q ∈ U, f (anchorDistance c q)) ≤ ∑ z ∈ V, f z.1 := by calc _ = ∑ z ∈ U.image g, f z.1 := by rw [Finset.sum_image hinj] _ ≤ _ := Finset.sum_le_sum_of_subset hmaps have hsame : (∑ q ∈ Finset.Icc 1 N, f (anchorDistance c q)) = ∑ q ∈ U, f (anchorDistance c q) := by have hh := Finset.sum_erase_add (Finset.Icc 1 N) (fun q => f (anchorDistance c q)) hc simpa only [anchorDistance, max_self, min_self, Nat.sub_self, hzero, add_zero] using hh.symm rw [hsame] simpa [V, Finset.sum_product, Finset.sum_mul, Finset.mul_sum, mul_comm] using hsum theorem witnessExceptionBound_le_second_moment {N c : ℕ} (hc : c ∈ Finset.Icc 1 N) : witnessExceptionBound N c ≤ 6 * ∑ n ∈ Finset.Icc 1 N, n.divisors.card ^ 2 := by have hfirst : (∑ q ∈ Finset.Icc 1 N, (anchorDistance c q).divisors.card) ≤ ∑ q ∈ Finset.Icc 1 N, (anchorDistance c q).divisors.card ^ 2 := by apply Finset.sum_le_sum intro q hq have hh := (anchorDistance c q).divisors.card nlinarith have hsecond := sum_anchorDistance_le_twice hc (fun n => n.divisors.card ^ 2) (by simp) dsimp [witnessExceptionBound] omega theorem witnessExceptionBound_le_reciprocalSum {N c : ℕ} (hc : c ∈ Finset.Icc 1 N) : (witnessExceptionBound N c : ℝ) ≤ 6 * (N : ℝ) * reciprocalSum N ^ 3 := by have hnat : (witnessExceptionBound N c : ℝ) ≤ 6 * ∑ n ∈ Finset.Icc 1 N, (n.divisors.card : ℝ)^2 := by exact_mod_cast witnessExceptionBound_le_second_moment hc have hmoment := divisor_second_moment_le_reciprocalSum N nlinarith only [hnat, hmoment] theorem witnessExceptionBound_le_natLog {N c : ℕ} (hc : c ∈ Finset.Icc 1 N) : witnessExceptionBound N c ≤ 48 * N * (Nat.log 2 N + 1)^3 := by have hbase := reciprocalSum_le_natLog N have hpow := pow_le_pow_left₀ (reciprocalSum_nonneg N) hbase 3 have hmul := mul_le_mul_of_nonneg_left hpow (by positivity : (0 : ℝ) ≤ 6 * (N : ℝ)) have hbound := (witnessExceptionBound_le_reciprocalSum hc).trans hmul have heq : 6 * (N : ℝ) * (2 * ((Nat.log 2 N : ℝ) + 1))^3 = ((48 * N * (Nat.log 2 N + 1)^3 : ℕ) : ℝ) := by push_cast; ring rw [heq] at hbound exact_mod_cast hbound end section open Finset theorem card_meeting_pairs_add {α : Type*} [DecidableEq α] (U P : Finset α) : ((U.powersetCard 2).filter (fun Q => ¬ Disjoint Q P)).card + (U \ P).card.choose 2 = U.card.choose 2 := by classical have heq : (U.powersetCard 2).filter (fun Q => Disjoint Q P) = (U \ P).powersetCard 2 := by ext Q simp only [Finset.mem_filter, Finset.mem_powersetCard] constructor · rintro ⟨⟨hQU, hcard⟩, hdis⟩ refine ⟨?_, hcard⟩ intro x hx exact Finset.mem_sdiff.mpr ⟨hQU hx, fun hxP => Finset.disjoint_left.mp hdis hx hxP⟩ · rintro ⟨hQ, hcard⟩ refine ⟨⟨fun x hx => (Finset.mem_sdiff.mp (hQ hx)).1, hcard⟩, ?_⟩ exact Finset.disjoint_left.mpr (fun x hx hxP => (Finset.mem_sdiff.mp (hQ hx)).2 hxP) have hh := Finset.card_filter_add_card_filter_not (s := U.powersetCard 2) (fun Q => Disjoint Q P) rw [heq, Finset.card_powersetCard, Finset.card_powersetCard] at hh omega theorem card_meeting_pairs_real {α : Type*} [DecidableEq α] {U P : Finset α} (hP : P ⊆ U) : (((U.powersetCard 2).filter (fun Q => ¬ Disjoint Q P)).card : ℝ) = (P.card : ℝ) * U.card - (P.card : ℝ)^2 / 2 - (P.card : ℝ) / 2 := by classical have hcard := card_meeting_pairs_add U P have hsub : (U \ P).card + P.card = U.card := Finset.card_sdiff_add_card_eq_card hP have hreal : (((U.powersetCard 2).filter (fun Q => ¬ Disjoint Q P)).card : ℝ) + ((U \ P).card : ℝ) * ((U \ P).card - 1) / 2 = (U.card : ℝ) * (U.card - 1) / 2 := by have hh : (((U.powersetCard 2).filter (fun Q => ¬ Disjoint Q P)).card : ℝ) + (((U \ P).card.choose 2 : ℕ) : ℝ) = ((U.card.choose 2 : ℕ) : ℝ) := by exact_mod_cast hcard simpa only [Nat.cast_choose_two] using hh have hsubreal : ((U \ P).card : ℝ) + (P.card : ℝ) = U.card := by exact_mod_cast hsub nlinarith only [hreal, hsubreal] theorem meetingPairPool_card_real {N c : ℕ} {P : Finset ℕ} (hP : P ⊆ Finset.Icc 1 N) (hcP : c ∉ P) : ((meetingPairPool N c P).card : ℝ) ≤ (P.card : ℝ) * N - (P.card : ℝ)^2 / 2 := by have hPU : P ⊆ (Finset.Icc 1 N).erase c := by intro p hp exact Finset.mem_erase.mpr ⟨fun hpc => hcP (hpc ▸ hp), hP hp⟩ have hcount := card_meeting_pairs_real hPU have hU : ((Finset.Icc 1 N).erase c).card ≤ N := by have hh := Finset.card_le_card (Finset.erase_subset (s := Finset.Icc 1 N) c) simpa only [Nat.card_Icc, Nat.add_sub_cancel] using hh have hUR : (((Finset.Icc 1 N).erase c).card : ℝ) ≤ N := by exact_mod_cast hU have hmul := mul_le_mul_of_nonneg_left hUR (Nat.cast_nonneg P.card : (0 : ℝ) ≤ P.card) change ((meetingPairPool N c P).card : ℝ) = _ at hcount nlinarith only [hcount, hmul, Nat.cast_nonneg (α := ℝ) P.card] theorem meetingPairPool_card_add_choose_le {N c : ℕ} {P : Finset ℕ} (hP : P ⊆ Finset.Icc 1 N) (hcP : c ∉ P) : (meetingPairPool N c P).card + P.card.choose 2 ≤ P.card * N := by have hbound := meetingPairPool_card_real hP hcP have hh : ((meetingPairPool N c P).card : ℝ) + ((P.card.choose 2 : ℕ) : ℝ) ≤ (P.card : ℝ) * N := by rw [Nat.cast_choose_two] nlinarith only [hbound, Nat.cast_nonneg (α := ℝ) P.card] exact_mod_cast hh theorem crooked_meeting_set_card_le_natLog {N c : ℕ} {F : Finset (Finset ℕ)} {P : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hcI : c ∈ Finset.Icc 1 N) (hcrooked : ∀ S ∈ F, IsCrooked S) (hP : P ⊆ Finset.Icc 1 N) (hcP : c ∉ P) (hmet : ∀ S ∈ F, (S.erase c ∩ P).Nonempty) : F.card + P.card.choose 2 ≤ P.card * N + 48 * N * (Nat.log 2 N + 1)^3 := by have hfamily := crooked_meeting_set_card_le hF hc hcrooked hmet have hpairs := meetingPairPool_card_add_choose_le hP hcP have hexception := witnessExceptionBound_le_natLog hcI omega end section open Finset theorem IsCrooked.card_three_le {S : Finset ℕ} (hS : IsCrooked S) : 3 ≤ S.card := by by_contra hcard have hsmall : S.card ≤ 2 := by omega rcases S.eq_empty_or_nonempty with hzero | hne · apply hS subst S exact ⟨0, by simp⟩ · obtain ⟨l, hl, hAP⟩ := nonempty_small_isAP hne hsmall exact hS ⟨l, hAP⟩ theorem arithInter_inter_nonempty {N : ℕ} {F : Finset (Finset ℕ)} {S T : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hS : S ∈ F) (hT : T ∈ F) (hSnonempty : S.Nonempty) : (S ∩ T).Nonempty := by by_cases hST : S = T · simpa only [hST, Finset.inter_self] using hST ▸ hSnonempty obtain ⟨l, hl, hAP⟩ := hF.2 hS hT hST by_contra hnot have heq : S ∩ T = ∅ := Finset.not_nonempty_iff_eq_empty.mp hnot rw [heq] at hAP exact Set.not_isAPOfLength_empty hl (by simpa using hAP) theorem crooked_two_point_cover_card_le {N : ℕ} {F : Finset (Finset ℕ)} {H : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hcrooked : ∀ S ∈ F, IsCrooked S) (hH : H ⊆ Finset.Icc 1 N) (hmet : ∀ S ∈ F, 2 ≤ (S ∩ H).card) : F.card ≤ H.card * (H.card * N + 48 * N * (Nat.log 2 N + 1)^3) := by classical let D : ℕ → Finset (Finset ℕ) := fun c => F.filter (fun S => c ∈ S) have hDsub : ∀ c, D c ⊆ F := fun c => Finset.filter_subset _ _ have hDc : ∀ c ∈ H, (D c).card ≤ H.card * N + 48 * N * (Nat.log 2 N + 1)^3 := by intro c hcH have hhit : ∀ S ∈ D c, (S.erase c ∩ H.erase c).Nonempty := by intro S hS have hSF := hDsub c hS have hcount := hmet S hSF have hne : ((S ∩ H).erase c).Nonempty := by apply Finset.card_pos.mp have hh := Finset.card_erase_add_one (Finset.mem_inter.mpr ⟨(Finset.mem_filter.mp hS).2, hcH⟩) omega obtain ⟨x, hx⟩ := hne obtain ⟨hxc, hxSH⟩ := Finset.mem_erase.mp hx obtain ⟨hxS, hxH⟩ := Finset.mem_inter.mp hxSH exact ⟨x, Finset.mem_inter.mpr ⟨Finset.mem_erase.mpr ⟨hxc, hxS⟩, Finset.mem_erase.mpr ⟨hxc, hxH⟩⟩⟩ have hh := crooked_meeting_set_card_le_natLog (arithInterSet_mono hF (hDsub c)) (fun S hS => (Finset.mem_filter.mp hS).2) (hH hcH) (fun S hS => hcrooked S (hDsub c hS)) ((Finset.erase_subset _ _).trans hH) (Finset.notMem_erase _ _) hhit have hpc := Nat.mul_le_mul_right N (Finset.card_erase_le (s := H) (a := c)) omega have hcover : F ⊆ H.biUnion D := by intro S hS have hne : (S ∩ H).Nonempty := Finset.card_pos.mp (by have := hmet S hS; omega) obtain ⟨c, hc⟩ := hne exact Finset.mem_biUnion.mpr ⟨c, (Finset.mem_inter.mp hc).2, Finset.mem_filter.mpr ⟨hS, (Finset.mem_inter.mp hc).1⟩⟩ calc F.card ≤ (H.biUnion D).card := Finset.card_le_card hcover _ ≤ ∑ c ∈ H, (D c).card := Finset.card_biUnion_le _ ≤ ∑ c ∈ H, (H.card * N + 48 * N * (Nat.log 2 N + 1)^3) := Finset.sum_le_sum hDc _ = _ := by simp theorem crooked_anchored_with_avoider_card_le {N c : ℕ} {F D : Finset (Finset ℕ)} {T : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hDF : D ⊆ F) (hc : ∀ S ∈ D, c ∈ S) (hcI : c ∈ Finset.Icc 1 N) (hcrooked : ∀ S ∈ D, IsCrooked S) (hT : T ∈ F) (hcT : c ∉ T) : D.card ≤ T.card * N + 48 * N * (Nat.log 2 N + 1)^3 := by have hhit : ∀ S ∈ D, (S.erase c ∩ T).Nonempty := by intro S hS obtain ⟨x, hx⟩ := arithInter_inter_nonempty hF (hDF hS) hT ⟨c, hc S hS⟩ obtain ⟨hxS, hxT⟩ := Finset.mem_inter.mp hx exact ⟨x, Finset.mem_inter.mpr ⟨Finset.mem_erase.mpr ⟨fun hxc => hcT (hxc ▸ hxT), hxS⟩, hxT⟩⟩ have hh := crooked_meeting_set_card_le_natLog (arithInterSet_mono hF hDF) hc hcI hcrooked (Finset.mem_powerset.mp (hF.1 hT)) hcT hhit omega theorem two_points_in_union_of_singleton_inter {S T A : Finset ℕ} {c : ℕ} (hST : S ∩ T = {c}) (hcA : c ∉ A) (hAS : (A ∩ S).Nonempty) (hAT : (A ∩ T).Nonempty) : 2 ≤ (A ∩ (S ∪ T).erase c).card := by obtain ⟨x, hx⟩ := hAS obtain ⟨y, hy⟩ := hAT obtain ⟨hxA, hxS⟩ := Finset.mem_inter.mp hx obtain ⟨hyA, hyT⟩ := Finset.mem_inter.mp hy have hxc : x ≠ c := fun hh => hcA (hh ▸ hxA) have hyc : y ≠ c := fun hh => hcA (hh ▸ hyA) have hxy : x ≠ y := by intro hh have hxT : x ∈ T := hh ▸ hyT have hhmem : x ∈ ({c} : Finset ℕ) := hST ▸ Finset.mem_inter.mpr ⟨hxS, hxT⟩ exact hxc (Finset.mem_singleton.mp hhmem) have hxH : x ∈ A ∩ (S ∪ T).erase c := Finset.mem_inter.mpr ⟨hxA, Finset.mem_erase.mpr ⟨hxc, Finset.mem_union_left _ hxS⟩⟩ have hyH : y ∈ A ∩ (S ∪ T).erase c := Finset.mem_inter.mpr ⟨hyA, Finset.mem_erase.mpr ⟨hyc, Finset.mem_union_right _ hyT⟩⟩ have hsub : {x, y} ⊆ A ∩ (S ∪ T).erase c := by simp [Finset.insert_subset_iff, hxH, hyH] simpa only [Finset.card_pair hxy] using Finset.card_le_card hsub theorem small_crooked_no_common_point_card_le {N k s : ℕ} {F K : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hKF : K ⊆ F) (hcrooked : ∀ S ∈ K, IsCrooked S) (hsmall : ∀ S ∈ K, S.card ≤ k) (hbound : ∀ S ∈ F, S.card ≤ s) (hno : ∀ c ∈ Finset.Icc 1 N, ∃ T ∈ F, c ∉ T) : K.card ≤ s * N + 4 * k^2 * N + (2 * k + 1) * (48 * N * (Nat.log 2 N + 1)^3) := by classical let E := 48 * N * (Nat.log 2 N + 1)^3 rcases K.eq_empty_or_nonempty with hKzero | hKne · simp [hKzero] by_cases hsingle : ∃ S ∈ K, ∃ T ∈ K, (S ∩ T).card = 1 · obtain ⟨S, hS, T, hT, hcard⟩ := hsingle obtain ⟨c, hST⟩ := Finset.card_eq_one.mp hcard have hcS : c ∈ S := (Finset.mem_inter.mp (hST.symm ▸ Finset.mem_singleton_self c)).1 have hcI : c ∈ Finset.Icc 1 N := Finset.mem_powerset.mp (hF.1 (hKF hS)) hcS obtain ⟨V, hV, hcV⟩ := hno c hcI let D := K.filter (fun A => c ∈ A) let B := K.filter (fun A => c ∉ A) have hDK : D ⊆ K := Finset.filter_subset _ _ have hBK : B ⊆ K := Finset.filter_subset _ _ have hD := crooked_anchored_with_avoider_card_le hF (hDK.trans hKF) (fun A hA => (Finset.mem_filter.mp hA).2) hcI (fun A hA => hcrooked A (hDK hA)) hV hcV have hVN := Nat.mul_le_mul_right N (hbound V hV) have hhit : ∀ A ∈ B, 2 ≤ (A ∩ (S ∪ T).erase c).card := by intro A hA have hAne : A.Nonempty := Finset.card_pos.mp (by have := (hcrooked A (hBK hA)).card_three_le omega) exact two_points_in_union_of_singleton_inter hST (Finset.mem_filter.mp hA).2 (arithInter_inter_nonempty hF (hKF (hBK hA)) (hKF hS) hAne) (arithInter_inter_nonempty hF (hKF (hBK hA)) (hKF hT) hAne) have hHsub : (S ∪ T).erase c ⊆ Finset.Icc 1 N := (Finset.erase_subset _ _).trans (Finset.union_subset (Finset.mem_powerset.mp (hF.1 (hKF hS))) (Finset.mem_powerset.mp (hF.1 (hKF hT)))) have hB := crooked_two_point_cover_card_le (arithInterSet_mono hF (hBK.trans hKF)) (fun A hA => hcrooked A (hBK hA)) hHsub hhit have hHcard : ((S ∪ T).erase c).card ≤ 2 * k := by have hh := (Finset.card_erase_le (s := S ∪ T) (a := c)).trans (Finset.card_union_le S T) have hs := hsmall S hS have ht := hsmall T hT omega have hBlim : B.card ≤ (2 * k) * (2 * k * N + E) := hB.trans (Nat.mul_le_mul hHcard (Nat.add_le_add_right (Nat.mul_le_mul_right N hHcard) E)) have hpartition := Finset.card_filter_add_card_filter_not (s := K) (fun A => c ∈ A) change D.card + B.card = K.card at hpartition change D.card ≤ V.card * N + E at hD change K.card ≤ s * N + 4 * k^2 * N + (2 * k + 1) * E nlinarith only [hD, hVN, hBlim, hpartition] · obtain ⟨H, hH⟩ := hKne have hhit : ∀ A ∈ K, 2 ≤ (A ∩ H).card := by intro A hA have hAne : A.Nonempty := Finset.card_pos.mp (by have := (hcrooked A hA).card_three_le omega) have hne := arithInter_inter_nonempty hF (hKF hA) (hKF hH) hAne have hpos := Finset.card_pos.mpr hne have hnot : (A ∩ H).card ≠ 1 := fun hh => hsingle ⟨A, hA, H, hH, hh⟩ omega have hh := crooked_two_point_cover_card_le (arithInterSet_mono hF hKF) hcrooked (Finset.mem_powerset.mp (hF.1 (hKF hH))) hhit have hhk := hsmall H hH have hlim : K.card ≤ k * (k * N + E) := hh.trans (Nat.mul_le_mul hhk (Nat.add_le_add_right (Nat.mul_le_mul_right N hhk) E)) change K.card ≤ s * N + 4 * k^2 * N + (2 * k + 1) * E nlinarith only [hlim, Nat.zero_le (s * N), Nat.zero_le (k^2 * N), Nat.zero_le (k * E), Nat.zero_le E] end section open Finset theorem factorization_le_log_two {n p : ℕ} (hn : n ≠ 0) (hp : p ∈ n.primeFactors) : n.factorization p ≤ Nat.log 2 n := by apply (Nat.le_log_iff_pow_le (by decide) hn).mpr calc 2 ^ n.factorization p ≤ p ^ n.factorization p := Nat.pow_le_pow_left (Nat.prime_of_mem_primeFactors hp).two_le _ _ ≤ n := Nat.le_of_dvd (Nat.pos_of_ne_zero hn) (Nat.ordProj_dvd n p) theorem divisor_card_pow_le_log_power {n : ℕ} (hn : n ≠ 0) (k : ℕ) : n.divisors.card ^ k ≤ n * (Nat.log 2 n + 1)^(k * 2^k) := by classical let L := Nat.log 2 n + 1 let S := n.primeFactors.filter (fun p => p < 2^k) have hL : 1 ≤ L := by dsimp [L]; omega have hScard : S.card ≤ 2^k := by have hsub : S ⊆ Finset.range (2^k) := fun p hp => Finset.mem_range.mpr (Finset.mem_filter.mp hp).2 simpa only [Finset.card_range] using Finset.card_le_card hsub have hfactor : ∀ p ∈ n.primeFactors, (n.factorization p + 1)^k ≤ (if p < 2^k then L^k else 1) * p ^ n.factorization p := by intro p hp by_cases hpk : p < 2^k · rw [if_pos hpk] have he : n.factorization p + 1 ≤ L := Nat.add_le_add_right (factorization_le_log_two hn hp) 1 have hp1 : 1 ≤ p ^ n.factorization p := Nat.one_le_pow _ _ (Nat.prime_of_mem_primeFactors hp).pos exact (Nat.pow_le_pow_left he k).trans (Nat.le_mul_of_pos_right _ hp1) · rw [if_neg hpk, one_mul] calc (n.factorization p + 1)^k ≤ (2 ^ n.factorization p)^k := Nat.pow_le_pow_left (Nat.succ_le_of_lt Nat.lt_two_pow_self) k _ = (2^k) ^ n.factorization p := by rw [← pow_mul, ← pow_mul, Nat.mul_comm] _ ≤ p ^ n.factorization p := Nat.pow_le_pow_left (by omega) _ have hprod : n.divisors.card ^ k ≤ (∏ p ∈ n.primeFactors, if p < 2^k then L^k else 1) * n := by rw [Nat.card_divisors hn, ← Finset.prod_pow] calc _ ≤ ∏ p ∈ n.primeFactors, ((if p < 2^k then L^k else 1) * p ^ n.factorization p) := Finset.prod_le_prod' hfactor _ = _ := by rw [Finset.prod_mul_distrib, ← Nat.prod_primeFactors_pow_factorization hn] have hprodEq : (∏ p ∈ n.primeFactors, if p < 2^k then L^k else 1) = L^(k * S.card) := by simp [Finset.prod_ite, S, pow_mul] rw [hprodEq] at hprod have hpower : L^(k * S.card) ≤ L^(k * 2^k) := Nat.pow_le_pow_right hL (Nat.mul_le_mul_left k hScard) exact hprod.trans (by simpa only [Nat.mul_comm] using Nat.mul_le_mul_right n hpower) end section open Finset Filter theorem eventually_natLog_pow_le (k : ℕ) : ∀ᶠ n : ℕ in Filter.atTop, (Nat.log 2 n + 1)^k ≤ n := by have ho := (Real.isLittleO_pow_logb_id_atTop (b := (2 : ℝ)) (n := k)).bound (by positivity : (0 : ℝ) < ((2 : ℝ)^k)⁻¹) have hnat : ∀ᶠ n : ℕ in Filter.atTop, ‖Real.logb 2 (n : ℝ)^k‖ ≤ ((2 : ℝ)^k)⁻¹ * ‖(n : ℝ)‖ := (tendsto_natCast_atTop_atTop : Tendsto (fun n : ℕ => (n : ℝ)) atTop atTop).eventually ho filter_upwards [hnat, Filter.eventually_ge_atTop 2] with n hn hn2 have hlogn : 1 ≤ Nat.log 2 n := (Nat.le_log_iff_pow_le (by decide) (by omega)).mpr (by simpa using hn2) have hcast : (1 : ℝ) ≤ Nat.log 2 n := by exact_mod_cast hlogn have hle : (Nat.log 2 n : ℝ) ≤ Real.logb 2 n := by simpa only [Nat.cast_ofNat] using Real.natLog_le_logb n 2 have hlogpos : (0 : ℝ) ≤ Real.logb 2 n := by linarith have hbase : (Nat.log 2 n : ℝ) + 1 ≤ 2 * Real.logb 2 n := by linarith have hpow := pow_le_pow_left₀ (by positivity : (0 : ℝ) ≤ (Nat.log 2 n : ℝ) + 1) hbase k simp only [Real.norm_eq_abs, abs_of_nonneg (pow_nonneg hlogpos k), abs_of_nonneg (Nat.cast_nonneg n : (0 : ℝ) ≤ n)] at hn have hmul := mul_le_mul_of_nonneg_left hn (by positivity : (0 : ℝ) ≤ (2 : ℝ)^k) have htwo : (2 : ℝ)^k ≠ 0 := by positivity simp only [← mul_assoc, mul_inv_cancel₀ htwo, one_mul] at hmul rw [mul_pow] at hpow have hresult : (((Nat.log 2 n + 1)^k : ℕ) : ℝ) ≤ n := by push_cast exact hpow.trans hmul exact_mod_cast hresult theorem eventually_divisor_card_pow_le (k : ℕ) : ∀ᶠ n : ℕ in Filter.atTop, n.divisors.card^k ≤ n := by filter_upwards [eventually_natLog_pow_le ((2 * k) * 2^(2 * k)), Filter.eventually_ge_atTop 1] with n hn hn1 have hdiv := divisor_card_pow_le_log_power (by omega : n ≠ 0) (2 * k) have hmul := Nat.mul_le_mul_left n hn have hsq : (n.divisors.card^k)^2 ≤ n^2 := by have hh := hdiv.trans hmul simpa only [pow_mul, Nat.mul_comm 2 k, pow_two] using hh nlinarith only [hsq] theorem eventually_uniform_divisor_card_pow_le (k : ℕ) : ∀ᶠ N : ℕ in Filter.atTop, ∀ n ≤ N, n.divisors.card^k ≤ N := by obtain ⟨n₀, hn₀⟩ := Filter.eventually_atTop.mp (eventually_divisor_card_pow_le k) filter_upwards [Filter.eventually_ge_atTop (n₀^k)] with N hN n hnN by_cases hn : n₀ ≤ n · exact (hn₀ n hn).trans hnN · have hcard : n.divisors.card ≤ n₀ := (Nat.card_divisors_le_self n).trans (by omega) exact (Nat.pow_le_pow_left hcard k).trans hN end section open Finset def coprimePrefix (m K : ℕ) : ℕ := ((Finset.Icc 1 K).filter (fun j => m.Coprime j)).card theorem moebius_divisor_indicator (n : ℕ) : (∑ d ∈ n.divisors, ArithmeticFunction.moebius d) = if n = 1 then 1 else 0 := by rw [← ArithmeticFunction.coe_mul_zeta_apply, ArithmeticFunction.moebius_mul_coe_zeta, ArithmeticFunction.one_apply] theorem coprime_moebius_indicator {m : ℕ} (hm : 0 < m) (j : ℕ) : (∑ d ∈ m.divisors, if d ∣ j then ArithmeticFunction.moebius d else 0) = if m.Coprime j then 1 else 0 := by have hg : Nat.gcd m j ≠ 0 := (Nat.gcd_pos_of_pos_left j hm).ne' have hfilter : m.divisors.filter (fun d => d ∣ j) = (Nat.gcd m j).divisors := by ext d simp only [Finset.mem_filter, Nat.mem_divisors] constructor · rintro ⟨⟨hdm, _⟩, hdj⟩ exact ⟨Nat.dvd_gcd hdm hdj, hg⟩ · rintro ⟨hdg, _⟩ exact ⟨⟨hdg.trans (Nat.gcd_dvd_left m j), hm.ne'⟩, hdg.trans (Nat.gcd_dvd_right m j)⟩ rw [← Finset.sum_filter, hfilter, moebius_divisor_indicator] theorem card_multiples_Icc (K d : ℕ) : ((Finset.Icc 1 K).filter (fun j => d ∣ j)).card = K / d := by have hset : (Finset.range (K + 1)).filter (fun j => j ≠ 0 ∧ d ∣ j) = (Finset.Icc 1 K).filter (fun j => d ∣ j) := by ext j simp only [Finset.mem_filter, Finset.mem_range, Finset.mem_Icc] omega rw [← hset] exact Nat.card_multiples' K d theorem coprimePrefix_moebius {m : ℕ} (hm : 0 < m) (K : ℕ) : (coprimePrefix m K : ℤ) = ∑ d ∈ m.divisors, ArithmeticFunction.moebius d * ((K / d : ℕ) : ℤ) := by calc (coprimePrefix m K : ℤ) = ∑ j ∈ Finset.Icc 1 K, if m.Coprime j then (1 : ℤ) else 0 := by simp [coprimePrefix] _ = ∑ j ∈ Finset.Icc 1 K, ∑ d ∈ m.divisors, if d ∣ j then ArithmeticFunction.moebius d else 0 := by exact Finset.sum_congr rfl (fun j hj => (coprime_moebius_indicator hm j).symm) _ = _ := by rw [Finset.sum_comm] apply Finset.sum_congr rfl intro d hd rw [← Finset.sum_filter] simp [Finset.sum_const, card_multiples_Icc, mul_comm] theorem coprimePrefix_moebius_real {m : ℕ} (hm : 0 < m) (K : ℕ) : (coprimePrefix m K : ℝ) = ∑ d ∈ m.divisors, (ArithmeticFunction.moebius d : ℝ) * ((K / d : ℕ) : ℝ) := by have hh := congrArg (fun z : ℤ => (z : ℝ)) (coprimePrefix_moebius hm K) simpa only [Int.cast_natCast, Int.cast_sum, Int.cast_mul] using hh theorem nat_div_error_le_one {K d : ℕ} (hd : 0 < d) : |((K / d : ℕ) : ℝ) - (K : ℝ) / d| ≤ 1 := by have hdR : (0 : ℝ) < d := Nat.cast_pos.mpr hd have hupper := Nat.cast_div_le (α := ℝ) (m := K) (n := d) have hlt : K < (K / d + 1) * d := by have hmod := Nat.mod_lt K hd have heq := Nat.mod_add_div K d nlinarith only [hmod, heq] have hlower : (K : ℝ) / d < ((K / d : ℕ) : ℝ) + 1 := by apply (div_lt_iff₀ hdR).mpr exact_mod_cast hlt exact abs_le.mpr ⟨by linarith, by linarith⟩ theorem moebius_reciprocal_totient {m : ℕ} (hm : 0 < m) : (∑ d ∈ m.divisors, (ArithmeticFunction.moebius d : ℝ) / d) = (m.totient : ℝ) / m := by have hprefix : coprimePrefix m m = m.totient := card_coprime_Icc m have hsum := coprimePrefix_moebius_real hm m rw [hprefix] at hsum have heq : (∑ d ∈ m.divisors, (ArithmeticFunction.moebius d : ℝ) / d) * (m : ℝ) = m.totient := by rw [Finset.sum_mul, hsum] apply Finset.sum_congr rfl intro d hd have hdpos : (0 : ℝ) < d := Nat.cast_pos.mpr (Nat.pos_of_mem_divisors hd) have hdiv : ((m / d : ℕ) : ℝ) = (m : ℝ) / d := by apply (eq_div_iff hdpos.ne').mpr exact_mod_cast Nat.div_mul_cancel (Nat.mem_divisors.mp hd).1 rw [hdiv] ring exact (eq_div_iff (Nat.cast_ne_zero.mpr hm.ne')).mpr heq theorem coprimePrefix_error_le {m : ℕ} (hm : 0 < m) (K : ℕ) : |(coprimePrefix m K : ℝ) - (K : ℝ) * m.totient / m| ≤ m.divisors.card := by have heq : (coprimePrefix m K : ℝ) - (K : ℝ) * m.totient / m = ∑ d ∈ m.divisors, (ArithmeticFunction.moebius d : ℝ) * (((K / d : ℕ) : ℝ) - (K : ℝ) / d) := by have hphi : (K : ℝ) * m.totient / m = (K : ℝ) * ∑ d ∈ m.divisors, (ArithmeticFunction.moebius d : ℝ) / d := by rw [moebius_reciprocal_totient hm] ring rw [coprimePrefix_moebius_real hm, hphi, Finset.mul_sum, ← Finset.sum_sub_distrib] apply Finset.sum_congr rfl intro d hd ring rw [heq] calc _ ≤ ∑ d ∈ m.divisors, |(ArithmeticFunction.moebius d : ℝ) * (((K / d : ℕ) : ℝ) - (K : ℝ) / d)| := Finset.abs_sum_le_sum_abs _ _ _ ≤ ∑ d ∈ m.divisors, (1 : ℝ) := by apply Finset.sum_le_sum intro d hd rw [abs_mul] have hmu : |(ArithmeticFunction.moebius d : ℝ)| ≤ 1 := by exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := d) exact (mul_le_mul hmu (nat_div_error_le_one (Nat.pos_of_mem_divisors hd)) (abs_nonneg _) (by norm_num)).trans (by norm_num) _ = _ := by simp theorem coprimeInterval_error_le {m A B : ℕ} (hm : 0 < m) (hAB : A ≤ B) : |(((Finset.Ioc A B).filter (fun j => m.Coprime j)).card : ℝ) - ((B : ℝ) - A) * m.totient / m| ≤ 2 * (m.divisors.card : ℝ) := by have hpartition : ((Finset.Ioc A B).filter (fun j => m.Coprime j)).card + coprimePrefix m A = coprimePrefix m B := by have hdis : Disjoint (Finset.Icc 1 A) (Finset.Ioc A B) := by apply Finset.disjoint_left.mpr intro j hjA hjB have ha := Finset.mem_Icc.mp hjA have hb := Finset.mem_Ioc.mp hjB omega have hunion : Finset.Icc 1 A ∪ Finset.Ioc A B = Finset.Icc 1 B := by ext j simp only [Finset.mem_union, Finset.mem_Icc, Finset.mem_Ioc] omega have hdis' : Disjoint ((Finset.Icc 1 A).filter (fun j => m.Coprime j)) ((Finset.Ioc A B).filter (fun j => m.Coprime j)) := Finset.disjoint_filter_filter hdis have hh := Finset.card_union_of_disjoint hdis' rw [← Finset.filter_union, hunion] at hh dsimp [coprimePrefix] omega have hpartR : (((Finset.Ioc A B).filter (fun j => m.Coprime j)).card : ℝ) + (coprimePrefix m A : ℝ) = coprimePrefix m B := by exact_mod_cast hpartition have hA := abs_le.mp (coprimePrefix_error_le hm A) have hB := abs_le.mp (coprimePrefix_error_le hm B) rw [sub_mul, sub_div] apply abs_le.mpr constructor <;> nlinarith only [hpartR, hA.1, hA.2, hB.1, hB.2] theorem coprimeInterval_log_lower {m A B : ℕ} (hm : 0 < m) (hAB : A ≤ B) : B - A ≤ (((Finset.Ioc A B).filter (fun j => m.Coprime j)).card + 2 * m.divisors.card) * (Nat.log 2 m + 1) := by let C := ((Finset.Ioc A B).filter (fun j => m.Coprime j)).card let L := Nat.log 2 m + 1 have hmR : (0 : ℝ) < m := Nat.cast_pos.mpr hm have hratio : (1 : ℝ) ≤ (L : ℝ) * m.totient / m := by apply (le_div_iff₀ hmR).mpr rw [one_mul] exact_mod_cast le_log_succ_mul_totient m have herror := (abs_le.mp (coprimeInterval_error_le hm hAB)).1 have hc : ((B : ℝ) - A) * m.totient / m ≤ (C : ℝ) + 2 * m.divisors.card := by dsimp [C] linarith only [herror] have hlen : (0 : ℝ) ≤ (B : ℝ) - A := sub_nonneg.mpr (by exact_mod_cast hAB) have hreal : (B : ℝ) - A ≤ ((C : ℝ) + 2 * m.divisors.card) * L := by calc _ = ((B : ℝ) - A) * 1 := by ring _ ≤ ((B : ℝ) - A) * ((L : ℝ) * m.totient / m) := mul_le_mul_of_nonneg_left hratio hlen _ = (L : ℝ) * (((B : ℝ) - A) * m.totient / m) := by ring _ ≤ (L : ℝ) * ((C : ℝ) + 2 * m.divisors.card) := mul_le_mul_of_nonneg_left hc (Nat.cast_nonneg L) _ = _ := by ring have hcast : ((B - A : ℕ) : ℝ) ≤ (((C + 2 * m.divisors.card) * L : ℕ) : ℝ) := by simpa only [Nat.cast_sub hAB, Nat.cast_mul, Nat.cast_add, Nat.cast_ofNat] using hreal exact_mod_cast hcast theorem coprimeInterval_log_density {m A B : ℕ} (hm : 0 < m) (hAB : A ≤ B) (hlength : 4 * m.divisors.card * (Nat.log 2 m + 1) ≤ B - A) : B - A ≤ 2 * ((Finset.Ioc A B).filter (fun j => m.Coprime j)).card * (Nat.log 2 m + 1) := by have hh := coprimeInterval_log_lower hm hAB nlinarith only [hh, hlength] end section open Finset theorem fixedGap_core {S : Finset ℕ} {u v : ℕ} (huv : u < v) (hu : u ∈ S) (hv : v ∈ S) : ∃ U : Finset ℕ, U ⊆ S ∧ (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) ∧ ConsecutiveIn U u v ∧ ∀ T ⊆ S, FixedGapAP u v T → T ⊆ U := by classical let D := S.powerset.filter (fun T => FixedGapAP u v T) let U := D.biUnion id have hpairCon : ConsecutiveIn {u, v} u v := by refine ⟨by simp, by simp, huv, ?_⟩ intro x hx hbetween simp only [Finset.mem_insert, Finset.mem_singleton] at hx omega have hpairAP : (({u, v} : Finset ℕ) : Set ℕ).IsAPOfLength 2 := by simpa using Nat.isAPOfLength_pair huv have hpairD : {u, v} ∈ D := Finset.mem_filter.mpr ⟨Finset.mem_powerset.mpr (by simp [Finset.insert_subset_iff, hu, hv]), Or.inr ⟨⟨2, hpairAP⟩, hpairCon⟩⟩ have huU : u ∈ U := Finset.mem_biUnion.mpr ⟨{u, v}, hpairD, by simp⟩ have hclass : FixedGapAP u v U := union_closed_biUnion (fixedGapAP_empty u v) (fun T V hT hV => fixedGapAP_union hT hV) D id (fun T hT => (Finset.mem_filter.mp hT).2) have hUP : (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) ∧ ConsecutiveIn U u v := by rcases hclass with hzero | hclass · simp [hzero] at huU · exact hclass refine ⟨U, ?_, hUP.1, hUP.2, ?_⟩ · intro x hx obtain ⟨T, hT, hxT⟩ := Finset.mem_biUnion.mp hx exact Finset.mem_powerset.mp (Finset.mem_filter.mp hT).1 hxT · intro T hTS hT x hx exact Finset.mem_biUnion.mpr ⟨T, Finset.mem_filter.mpr ⟨Finset.mem_powerset.mpr hTS, hT⟩, hx⟩ theorem natAP_prefix_subset_of_endpoints {a d k u v t : ℕ} (hd : 0 < d) (hu : u ∈ natAP a d k) (hv : v ∈ natAP a d k) (ht : u + t * d ≤ v) : natAP u d (t + 1) ⊆ natAP a d k := by have huv : u ≤ v := by omega have hslice := natAP_inter_Icc_eq_segment hd hu hv huv intro x hx obtain ⟨i, hi, hxi⟩ := mem_natAP.mp hx have hit : i * d ≤ t * d := Nat.mul_le_mul_right d (by omega : i ≤ t) have hxseg : x ∈ apSegment u v d := by apply Finset.mem_filter.mpr refine ⟨Finset.mem_Icc.mpr ⟨by omega, by omega⟩, ?_⟩ rw [← hxi, Nat.add_sub_cancel_left] exact dvd_mul_left d i exact (Finset.mem_inter.mp (hslice.symm ▸ hxseg)).1 theorem natAP_consecutive_of_neighbor {a d k u : ℕ} (hd : 0 < d) (hu : u ∈ natAP a d k) (hv : u + d ∈ natAP a d k) : ConsecutiveIn (natAP a d k) u (u + d) := by refine ⟨hu, hv, by omega, ?_⟩ intro x hx hbetween have hdiv := natAP_dvd_anchorDistance hu hx have hux : u ≤ x := by omega rw [anchorDistance, max_eq_right hux, min_eq_left hux] at hdiv have hle := Nat.le_of_dvd (by omega : 0 < x - u) hdiv omega theorem proper_divisor_double_le {e d : ℕ} (he : 0 < e) (hed : e ∣ d) (hlt : e < d) : 2 * e ≤ d := by obtain ⟨q, hq⟩ := hed have hq2 : 2 ≤ q := by nlinarith only [he, hlt, hq] nlinarith only [hq2, hq, he] theorem minimal_prefix_witness_core {S : Finset ℕ} {c d K : ℕ} (hd : 0 < d) (hK : 1 ≤ K) (hprefix : natAP c d (K + 1) ⊆ S) (hmin : ∀ e : ℕ, 0 < e → natAP c e (K + 1) ⊆ S → d ≤ e) : ∃ U : Finset ℕ, U ⊆ S ∧ (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) ∧ natAP c d (K + 1) ⊆ U ∧ ∀ z ∈ S, z ∉ U → ∀ p : ℕ, 0 < p → p ≤ K → K ≤ 2 * p → p.Coprime (anchorDistance c z) → IsWitnessPair S c {c + p * d, z} := by have hcP : c ∈ natAP c d (K + 1) := mem_natAP.mpr ⟨0, by omega, by simp⟩ have hvP : c + d ∈ natAP c d (K + 1) := mem_natAP.mpr ⟨1, by omega, by simp⟩ obtain ⟨U, hUS, hUAP, hUcon, hmax⟩ := fixedGap_core (by omega : c < c + d) (hprefix hcP) (hprefix hvP) have hPU : natAP c d (K + 1) ⊆ U := hmax _ hprefix (Or.inr ⟨⟨K + 1, natAP_isAP hd⟩, natAP_consecutive_of_neighbor hd hcP hvP⟩) refine ⟨U, hUS, hUAP, hPU, ?_⟩ intro z hz hzU p hp hpK hKp hcop let y := c + p * d have hyP : y ∈ natAP c d (K + 1) := mem_natAP.mpr ⟨p, by omega, rfl⟩ have hyU : y ∈ U := hPU hyP have hyS : y ∈ S := hUS hyU have hcy : c < y := by dsimp [y]; nlinarith only [hp, hd] have hzc : z ≠ c := fun heq => hzU (heq.symm ▸ hPU hcP) have hyz : y ≠ z := fun heq => hzU (heq ▸ hyU) refine ⟨Finset.card_pair hyz, ?_, ?_⟩ · intro x hx simp only [Finset.mem_insert, Finset.mem_singleton] at hx rcases hx with rfl | rfl · exact Finset.mem_erase.mpr ⟨hcy.ne', hyS⟩ · exact Finset.mem_erase.mpr ⟨hzc, hz⟩ · rintro ⟨A, hAS, ⟨l, hAAP⟩, hCA⟩ have hcA : c ∈ A := hCA (by simp) have hyA : y ∈ A := hCA (by simp [y]) have hzA : z ∈ A := hCA (by simp) have hcardA : 2 ≤ A.card := by have hsub : {c, y} ⊆ A := by simp [Finset.insert_subset_iff, hcA, hyA] simpa [hcy.ne] using Finset.card_le_card hsub obtain ⟨a, e, he, hArep⟩ := nat_ap_eq_natAP hAAP hcardA have hep : e ∣ p * d := by have hh := natAP_dvd_anchorDistance (hArep ▸ hcA) (hArep ▸ hyA) have hdist : anchorDistance c y = p * d := by dsimp [anchorDistance, y]; omega simpa only [hdist] using hh have hez : e ∣ anchorDistance c z := natAP_dvd_anchorDistance (hArep ▸ hcA) (hArep ▸ hzA) have hecop : e.Coprime p := (hcop.of_dvd_right hez).symm have hed : e ∣ d := hecop.dvd_of_dvd_mul_left hep have heD : e ≤ d := Nat.le_of_dvd hd hed by_cases heq : e = d · have hvA : c + d ∈ A := by have hsub := natAP_prefix_subset_of_endpoints he (hArep ▸ hcA) (hArep ▸ hyA) (t := 1) (by dsimp [y] at hcy ⊢; nlinarith only [hp, heq]) apply hArep.symm ▸ (hsub ?_) exact mem_natAP.mpr ⟨1, by omega, by simpa only [one_mul, heq]⟩ have hcon : ConsecutiveIn A c (c + d) := by have hvAe : c + e ∈ A := by simpa only [heq] using hvA have hh := natAP_consecutive_of_neighbor he (hArep ▸ hcA) (hArep ▸ hvAe) have hhA : ConsecutiveIn A c (c + e) := hArep.symm ▸ hh simpa only [heq] using hhA exact hzU (hmax A hAS (Or.inr ⟨⟨l, hAAP⟩, hcon⟩) hzA) · have hdouble : 2 * e ≤ d := proper_divisor_double_le he hed (by omega) have hKe : c + K * e ≤ y := by dsimp [y]; nlinarith only [hdouble, hKp] have hsmallPrefix : natAP c e (K + 1) ⊆ S := (natAP_prefix_subset_of_endpoints he (hArep ▸ hcA) (hArep ▸ hyA) hKe).trans (hArep ▸ hAS) have hh := hmin e he hsmallPrefix omega end section open Finset noncomputable def structuralWitnessPairs (S : Finset ℕ) (c : ℕ) : Finset (Finset ℕ) := by classical exact ((S.erase c).powersetCard 2).filter (fun Q => IsWitnessPair S c Q) theorem mem_structuralWitnessPairs {S Q : Finset ℕ} {c : ℕ} : Q ∈ structuralWitnessPairs S c ↔ IsWitnessPair S c Q := by classical constructor · intro h exact (Finset.mem_filter.mp h).2 · intro h exact Finset.mem_filter.mpr ⟨Finset.mem_powersetCard.mpr ⟨h.2.1, h.1⟩, h⟩ theorem sum_structuralWitnessPairs_card_le {N c : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) : (∑ S ∈ F, (structuralWitnessPairs S c).card) ≤ N.choose 2 := by classical let U := F.sigma (fun S => structuralWitnessPairs S c) have hmaps : Set.MapsTo (fun q : (Σ _ : Finset ℕ, Finset ℕ) => q.2) (U : Set (Σ _ : Finset ℕ, Finset ℕ)) ((Finset.Icc 1 N).powersetCard 2 : Set (Finset ℕ)) := by intro q hq obtain ⟨hS, hQ⟩ := Finset.mem_sigma.mp hq have hW := mem_structuralWitnessPairs.mp hQ refine Finset.mem_powersetCard.mpr ⟨?_, hW.1⟩ exact hW.2.1.trans ((Finset.erase_subset _ _).trans (Finset.mem_powerset.mp (hF.1 hS))) have hinj : Set.InjOn (fun q : (Σ _ : Finset ℕ, Finset ℕ) => q.2) (U : Set (Σ _ : Finset ℕ, Finset ℕ)) := by rintro ⟨S, Q⟩ hu ⟨T, R⟩ hv hQR change Q = R at hQR obtain ⟨hS, hQ⟩ := Finset.mem_sigma.mp hu obtain ⟨hT, hR⟩ := Finset.mem_sigma.mp hv have hWQ := mem_structuralWitnessPairs.mp hQ have hWR := mem_structuralWitnessPairs.mp hR have hTS : T = S := witness_pair_private hF hS hT (hc S hS) (hc T hT) hWQ (by simpa only [hQR] using hWR.2.1.trans (Finset.erase_subset _ _)) cases hTS cases hQR rfl simpa only [U, Finset.card_sigma, Finset.card_powersetCard, Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card_of_injOn _ hmaps hinj theorem minimal_prefix_witnesses_count {S U : Finset ℕ} {c d K : ℕ} (hd : 0 < d) (hPU : natAP c d (K + 1) ⊆ U) (hW : ∀ z ∈ S, z ∉ U → ∀ p : ℕ, 0 < p → p ≤ K → K ≤ 2 * p → p.Coprime (anchorDistance c z) → IsWitnessPair S c {c + p * d, z}) : (∑ z ∈ S \ U, ((Finset.Ioc (K / 2) K).filter (fun p => (anchorDistance c z).Coprime p)).card) ≤ (structuralWitnessPairs S c).card := by classical let V := (S \ U).sigma (fun z => (Finset.Ioc (K / 2) K).filter (fun p => (anchorDistance c z).Coprime p)) let f : (Σ _ : ℕ, ℕ) → Finset ℕ := fun q => {c + q.2 * d, q.1} have hspec : ∀ q ∈ V, c + q.2 * d ∈ U ∧ q.1 ∉ U ∧ IsWitnessPair S c (f q) := by intro q hq obtain ⟨hz, hp⟩ := Finset.mem_sigma.mp hq obtain ⟨hzS, hzU⟩ := Finset.mem_sdiff.mp hz obtain ⟨hpI, hcop⟩ := Finset.mem_filter.mp hp obtain ⟨hphalf, hpK⟩ := Finset.mem_Ioc.mp hpI have hppos : 0 < q.2 := by omega have hKp : K ≤ 2 * q.2 := by omega refine ⟨hPU (mem_natAP.mpr ⟨q.2, by omega, rfl⟩), hzU, ?_⟩ exact hW q.1 hzS hzU q.2 hppos hpK hKp hcop.symm have hmaps : Set.MapsTo f (V : Set (Σ _ : ℕ, ℕ)) (structuralWitnessPairs S c : Set (Finset ℕ)) := fun q hq => mem_structuralWitnessPairs.mpr (hspec q hq).2.2 have hinj : Set.InjOn f (V : Set (Σ _ : ℕ, ℕ)) := by rintro ⟨z, p⟩ hp ⟨w, q⟩ hq heq change ({c + p * d, z} : Finset ℕ) = {c + q * d, w} at heq have hpS := hspec ⟨z, p⟩ hp have hqS := hspec ⟨w, q⟩ hq have hzmem : z ∈ ({c + q * d, w} : Finset ℕ) := by rw [← heq]; simp have hz : z = w := by simp only [Finset.mem_insert, Finset.mem_singleton] at hzmem rcases hzmem with hbad | hzw · exact False.elim (hpS.2.1 (hbad.symm ▸ hqS.1)) · exact hzw have hymem : c + p * d ∈ ({c + q * d, w} : Finset ℕ) := by rw [← heq]; simp have hy : c + p * d = c + q * d := by simp only [Finset.mem_insert, Finset.mem_singleton] at hymem rcases hymem with hy | hbad · exact hy · exact False.elim (hqS.2.1 (hbad ▸ hpS.1)) have hpq : p = q := by nlinarith only [hy, hd] cases hz cases hpq rfl simpa only [V, Finset.card_sigma] using Finset.card_le_card_of_injOn f hmaps hinj theorem minimal_prefix_many_witnesses {N D c d K : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hd : 0 < d) (hK : 1 ≤ K) (hprefix : natAP c d (K + 1) ⊆ S) (hmin : ∀ e : ℕ, 0 < e → natAP c e (K + 1) ⊆ S → d ≤ e) (hdivisor : ∀ n ≤ N, n.divisors.card ≤ D) (hlength : 8 * D * (Nat.log 2 N + 1) ≤ K) : ∃ U : Finset ℕ, U ⊆ S ∧ (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) ∧ (S \ U).card * K ≤ 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card := by obtain ⟨U, hUS, hUAP, hPU, hW⟩ := minimal_prefix_witness_core hd hK hprefix hmin refine ⟨U, hUS, hUAP, ?_⟩ have hcP : c ∈ natAP c d (K + 1) := mem_natAP.mpr ⟨0, by omega, by simp⟩ have hcI : c ∈ Finset.Icc 1 N := hS (hprefix hcP) have hrow : ∀ z ∈ S \ U, K ≤ 4 * (Nat.log 2 N + 1) * ((Finset.Ioc (K / 2) K).filter (fun p => (anchorDistance c z).Coprime p)).card := by intro z hz obtain ⟨hzS, hzU⟩ := Finset.mem_sdiff.mp hz have hcz : c ≠ z := fun heq => hzU (heq ▸ hPU hcP) have hm : 0 < anchorDistance c z := anchorDistance_pos hcz have hmN : anchorDistance c z ≤ N := anchorDistance_le_of_mem hcI (hS hzS) have htau := hdivisor (anchorDistance c z) hmN have hlog : Nat.log 2 (anchorDistance c z) + 1 ≤ Nat.log 2 N + 1 := Nat.add_le_add_right (Nat.log_mono_right hmN) 1 have hcoef := Nat.mul_le_mul htau hlog have hlen : 4 * (anchorDistance c z).divisors.card * (Nat.log 2 (anchorDistance c z) + 1) ≤ K - K / 2 := by have hhalf : K ≤ 2 * (K - K / 2) := by omega nlinarith only [hcoef, hlength, hhalf] have hcount := coprimeInterval_log_density hm (Nat.div_le_self K 2) hlen have hcount' := hcount.trans (Nat.mul_le_mul_left (2 * ((Finset.Ioc (K / 2) K).filter (fun p => (anchorDistance c z).Coprime p)).card) hlog) have hhalf : K ≤ 2 * (K - K / 2) := by omega nlinarith only [hcount', hhalf] have hsum := Finset.sum_le_sum hrow have hcount := minimal_prefix_witnesses_count hd hPU hW have hbound := Nat.mul_le_mul_left (4 * (Nat.log 2 N + 1)) hcount simp only [Finset.sum_const, smul_eq_mul, ← Finset.mul_sum] at hsum omega end section open Finset theorem apSegment_mono_step {u v d e : ℕ} (hed : e ∣ d) : apSegment u v d ⊆ apSegment u v e := by intro x hx obtain ⟨hxI, hdx⟩ := Finset.mem_filter.mp hx exact Finset.mem_filter.mpr ⟨hxI, hed.trans hdx⟩ theorem exists_divisor_minimal_trace {S : Finset ℕ} {c p d : ℕ} (hd : 0 < d) (htrace : apSegment c p d ⊆ S) : ∃ e : ℕ, 0 < e ∧ e ∣ d ∧ apSegment c p e ⊆ S ∧ ∀ f : ℕ, 0 < f → f ∣ e → apSegment c p f ⊆ S → e ≤ f := by let D := d.divisors.filter (fun e => apSegment c p e ⊆ S) have hdD : d ∈ D := Finset.mem_filter.mpr ⟨Nat.mem_divisors.mpr ⟨dvd_refl d, hd.ne'⟩, htrace⟩ have hD : D.Nonempty := ⟨d, hdD⟩ let e := D.min' hD have heD : e ∈ D := Finset.min'_mem D hD have hediv := Nat.mem_divisors.mp (Finset.mem_filter.mp heD).1 refine ⟨e, Nat.pos_of_mem_divisors (Finset.mem_filter.mp heD).1, hediv.1, (Finset.mem_filter.mp heD).2, ?_⟩ intro f hf hfe hfS exact Finset.min'_le D f (Finset.mem_filter.mpr ⟨Nat.mem_divisors.mpr ⟨hfe.trans hediv.1, hd.ne'⟩, hfS⟩) theorem minimal_trace_witness_core {S : Finset ℕ} {c p d : ℕ} (hcp : c < p) (hd : 0 < d) (hddiv : d ∣ p - c) (htrace : apSegment c p d ⊆ S) (hmin : ∀ e : ℕ, 0 < e → e ∣ d → apSegment c p e ⊆ S → d ≤ e) : ∃ U : Finset ℕ, U ⊆ S ∧ (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) ∧ apSegment c p d ⊆ U ∧ ∀ z ∈ S, p ≤ z → z ∉ U → ∀ i : ℕ, 0 < i → c + i * d ∈ U → i.Coprime (anchorDistance c z) → IsWitnessPair S c {c + i * d, z} := by have hdlen : d ≤ p - c := Nat.le_of_dvd (by omega) hddiv have hcT : c ∈ apSegment c p d := Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨le_rfl, hcp.le⟩, by simp⟩ have hvT : c + d ∈ apSegment c p d := Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨by omega, by omega⟩, by simp⟩ have hrep := apSegment_eq_natAP hcp.le hd have hTcon : ConsecutiveIn (apSegment c p d) c (c + d) := hrep.symm ▸ natAP_consecutive_of_neighbor hd (hrep ▸ hcT) (hrep ▸ hvT) obtain ⟨U, hUS, hUAP, hUcon, hmax⟩ := fixedGap_core (by omega : c < c + d) (htrace hcT) (htrace hvT) have hTU : apSegment c p d ⊆ U := hmax _ htrace (Or.inr ⟨apSegment_isAP hcp.le hd, hTcon⟩) refine ⟨U, hUS, hUAP, hTU, ?_⟩ intro z hz hpz hzU i hi hyU hcop let y := c + i * d have hcy : c < y := by dsimp [y]; nlinarith only [hi, hd] have hzc : z ≠ c := by omega have hyz : y ≠ z := fun heq => hzU (heq ▸ hyU) refine ⟨Finset.card_pair hyz, ?_, ?_⟩ · intro x hx simp only [Finset.mem_insert, Finset.mem_singleton] at hx rcases hx with rfl | rfl · exact Finset.mem_erase.mpr ⟨hcy.ne', hUS hyU⟩ · exact Finset.mem_erase.mpr ⟨hzc, hz⟩ · rintro ⟨A, hAS, ⟨l, hAAP⟩, hCA⟩ have hcA : c ∈ A := hCA (by simp) have hyA : y ∈ A := hCA (by simp [y]) have hzA : z ∈ A := hCA (by simp) have hcard : 2 ≤ A.card := by have hsub : {c, y} ⊆ A := by simp [Finset.insert_subset_iff, hcA, hyA] simpa [hcy.ne] using Finset.card_le_card hsub obtain ⟨a, e, he, hArep⟩ := nat_ap_eq_natAP hAAP hcard have heid : e ∣ i * d := by have hh := natAP_dvd_anchorDistance (hArep ▸ hcA) (hArep ▸ hyA) have hdist : anchorDistance c y = i * d := by dsimp [anchorDistance, y]; omega simpa only [hdist] using hh have hez : e ∣ anchorDistance c z := natAP_dvd_anchorDistance (hArep ▸ hcA) (hArep ▸ hzA) have hed : e ∣ d := ((hcop.of_dvd_right hez).symm).dvd_of_dvd_mul_left heid have hediv : e ∣ p - c := hed.trans hddiv have hTeA : apSegment c p e ⊆ A := by rw [apSegment_eq_natAP hcp.le he] have hlast : c + ((p - c) / e) * e ≤ z := by rw [Nat.div_mul_cancel hediv] omega exact (natAP_prefix_subset_of_endpoints he (hArep ▸ hcA) (hArep ▸ hzA) hlast).trans (by rw [← hArep]) have hde : d ≤ e := hmin e he hed (hTeA.trans hAS) have hed' : e ≤ d := Nat.le_of_dvd hd hed have heq : e = d := by omega have hvAe : c + e ∈ A := hTeA (by simpa only [heq] using hvT) have hcon : ConsecutiveIn A c (c + d) := by have hh := natAP_consecutive_of_neighbor he (hArep ▸ hcA) (hArep ▸ hvAe) have hhA : ConsecutiveIn A c (c + e) := hArep.symm ▸ hh simpa only [heq] using hhA exact hzU (hmax A hAS (Or.inr ⟨⟨l, hAAP⟩, hcon⟩) hzA) theorem coprime_index_recovers_divisor {D d e i j : ℕ} (hd : d ∣ D) (he : e ∣ D) (hi : i.Coprime D) (hj : j.Coprime D) (hcode : i * d = j * e) : d = e := by have hleft : Nat.gcd (i * d) D = d := by rw [hi.gcd_mul_left_cancel, Nat.gcd_eq_left hd] have hright : Nat.gcd (j * e) D = e := by rw [hj.gcd_mul_left_cancel, Nat.gcd_eq_left he] exact hleft.symm.trans ((congrArg (fun n => Nat.gcd n D) hcode).trans hright) end section theorem quadratic_deficit {L w k : ℝ} (hL : 0 ≤ L) (hw : 0 ≤ w) (hk : k ≤ 5 / 3) : (L ^ 2 + w ^ 2) / 100 ≤ L ^ 2 / 2 + w ^ 2 / 4 - (k - 1) * L * w := by have hkw := mul_le_mul_of_nonneg_right hk (mul_nonneg hL hw) nlinarith [sq_nonneg (7 * L - 5 * w), sq_nonneg L, sq_nonneg w] theorem retained_deficit {n q c r x s k : ℝ} (hq : 0 ≤ q) (hc : 0 ≤ c) (hx : 0 ≤ x) (hsr : s ≤ r) (hk0 : 0 ≤ k) (hk : k ≤ 5 / 3) (hn : n = q + c + r + x) : k * x * (q + c) + r * x + k * c * (r - s) + s * (q + c + r) - s ^ 2 / 2 ≤ n ^ 2 / 2 - ((q + c) ^ 2 + x ^ 2) / 100 := by let L := q + c let w := x + r - s have hL : 0 ≤ L := add_nonneg hq hc have hw : 0 ≤ w := by dsimp [w]; linarith have hxw : x ≤ w := by dsimp [w]; linarith have hkw := quadratic_deficit hL hw hk have hmain : k * x * (q + c) + r * x + k * c * (r - s) + s * (q + c + r) - s ^ 2 / 2 ≤ k * L * w + w ^ 2 / 4 + s * (L + w) + s ^ 2 / 2 := by have hprod := mul_nonneg (mul_nonneg hk0 hq) (sub_nonneg.mpr hsr) dsimp [L, w] nlinarith [sq_nonneg (x - (r - s))] have hidentity : n ^ 2 / 2 - (k * L * w + w ^ 2 / 4 + s * (L + w) + s ^ 2 / 2) = L ^ 2 / 2 + w ^ 2 / 4 - (k - 1) * L * w := by rw [hn] dsimp [L, w] ring have hsq : x ^ 2 ≤ w ^ 2 := sq_le_sq₀ hx hw |>.mpr hxw dsimp [L] at hidentity hmain hkw linarith end section /-- The alternatives after the structural reduction, including possible reflection. -/ def ReducedFamilyStructure (N : ℕ) (G : Finset (Finset ℕ)) : Prop := (∃ c : ℕ, ∀ S ∈ G, c ∈ S) ∨ (∃ c L R : ℕ, c < L ∧ L ≤ R ∧ R ≤ N ∧ 256 * (L + N - R) * (Nat.log 2 N + 1) ≤ N ∧ ∀ S ∈ G, c ∉ S → ∃ a b : ℕ, c < a ∧ a ≤ L ∧ R ≤ b ∧ b ≤ N ∧ S = Finset.Icc a b) /-- The structural statement proved below by `structural_reduction`. -/ def StructuralReduction : Prop := ∃ N₀ : ℕ, ∀ N : ℕ, N₀ ≤ N → ∀ F : Finset (Finset ℕ), Erdos272.IsArithInterSet N F → (N : ℝ)^2 / 2 ≤ (F.card : ℝ) → ∃ G : Finset (Finset ℕ), Erdos272.IsArithInterSet N G ∧ F.card ≤ G.card + 2048 * N ∧ ReducedFamilyStructure N G theorem reduced_family_card_le {N : ℕ} {G : Finset (Finset ℕ)} (hG : Erdos272.IsArithInterSet N G) (hstructure : ReducedFamilyStructure N G) : G.card ≤ N.choose 2 + 20003 * N := by rcases hstructure with ⟨c, hc⟩ | ⟨c, L, R, hcL, hLR, hRN, hN, hinterval⟩ · have hh := common_point_card_le hG hc omega · exact long_core_family_card_le hcL hLR hRN hN hG hinterval theorem finite_upper_bound_of_structural_reduction (hstructure : StructuralReduction) : FiniteUpperBound := by obtain ⟨N₀, hreduce⟩ := hstructure refine ⟨30000, N₀, ?_⟩ intro N hN F hF have hNnonneg : (0 : ℝ) ≤ N := Nat.cast_nonneg N by_cases hlarge : (N : ℝ)^2 / 2 ≤ (F.card : ℝ) · obtain ⟨G, hG, hFG, hstruct⟩ := hreduce N hN F hF hlarge have hcardG := reduced_family_card_le hG hstruct have hcardF : F.card ≤ N.choose 2 + 22051 * N := by omega have hreal : (F.card : ℝ) ≤ (N.choose 2 : ℝ) + 22051 * (N : ℝ) := by exact_mod_cast hcardF rw [Nat.cast_choose_two] at hreal nlinarith only [hreal, hNnonneg] · nlinarith only [hlarge, hNnonneg] /-- Conditional on the explicit structural reduction; this is not an unconditional target proof. -/ theorem target_of_structural_reduction (hstructure : StructuralReduction) : fcTypeOfName% "Erdos272.erdos_272.variants.szabo_strong" := target_of_finite_upper_bound (finite_upper_bound_of_structural_reduction hstructure) end /- Midpoint -/ /- The explicit coprime index from the third supplied proof. -/ section theorem exists_coprime_near_half (m : ℕ) (hm : 6 ≤ m) : ∃ j : ℕ, 0 < j ∧ 2 * j ≤ m ∧ m ≤ 2 * j + 4 ∧ Nat.Coprime j m := by by_cases hodd : m % 2 = 1 · refine ⟨m / 2, by omega, by omega, by omega, ?_⟩ have heq : m = 2 * (m / 2) + 1 := by omega have hcop : Nat.Coprime (m / 2) (2 * (m / 2) + 1) := by simp simpa only [← heq] using hcop · have heq : m = 2 * (m / 2) := by omega by_cases heven : (m / 2) % 2 = 0 · refine ⟨m / 2 - 1, by omega, by omega, by omega, ?_⟩ have hcop : Nat.Coprime (m / 2 - 1) (m / 2) := by have hh : m / 2 - 1 + 1 = m / 2 := by omega rw [← hh] simp have hcop2 : Nat.Coprime (m / 2 - 1) 2 := Nat.coprime_two_right.mpr (Nat.odd_iff.mpr (by omega)) simpa only [← heq] using hcop2.mul_right hcop · refine ⟨m / 2 - 2, by omega, by omega, by omega, ?_⟩ have hjodd : (m / 2 - 2) % 2 = 1 := by omega have hcop2 : Nat.Coprime (m / 2 - 2) 2 := Nat.coprime_two_right.mpr (Nat.odd_iff.mpr hjodd) have hcop : Nat.Coprime (m / 2 - 2) (m / 2) := by have hh : m / 2 = (m / 2 - 2) + 2 := by omega have hp : Nat.Coprime (m / 2 - 2) ((m / 2 - 2) + 2) := by simpa only [Nat.coprime_self_add_right] using hcop2 simpa only [← hh] using hp simpa only [← heq] using hcop2.mul_right hcop end /- LinearExterior -/ /- A midpoint argument removes the logarithmic factor from the exterior-witness lemma. -/ section open Finset theorem prefix_top_cover_half {S : Finset ℕ} {c d h R v : ℕ} (hd : 0 < d) (hh : 1 ≤ h) (hprefix : S.filter (fun x => x ≤ R) = natAP c d (h + 1)) (hmin : ∀ x ∈ S, c ≤ x) (hwide : 3 * v + c ≤ 4 * R) (hcover : HasAPCover S {c, c + h * d, v}) : v + c ≤ 2 * (c + h * d) := by let z := c + h * d have hcz : c < z := by have hpos : 0 < h * d := Nat.mul_pos (by omega) hd dsimp [z] omega change v + c ≤ 2 * z by_contra hhalf obtain ⟨e, k, he, hk, hAS, hzA, hvA⟩ := hasAPCover_at_min hmin hcz hcover obtain ⟨i, hi, hzi⟩ := mem_natAP.mp hzA obtain ⟨j, hj, hvj⟩ := mem_natAP.mp hvA have hi1 : 1 ≤ i := by by_contra hlt have hi0 : i = 0 := by omega simp only [hi0, zero_mul, add_zero] at hzi omega have hij : i + 1 < j := by by_contra hlt have hmul := Nat.mul_le_mul_right e (by omega : j ≤ i + 1) have hew := Nat.mul_le_mul_right e hi1 nlinarith only [hmul, hew, hzi, hvj, hhalf] have hnext : c + (i + 1) * e ∈ S := hAS (mem_natAP.mpr ⟨i + 1, by omega, rfl⟩) have hnextR : R < c + (i + 1) * e := by by_contra hle have hbound := prefix_le_top hprefix hnext (by omega) change c + (i + 1) * e ≤ z at hbound nlinarith only [he, hbound, hzi] have hpred : c + (j - 1) * e ∈ S := hAS (mem_natAP.mpr ⟨j - 1, by omega, rfl⟩) have hpredz : z < c + (j - 1) * e := by have hmul := Nat.mul_lt_mul_of_pos_right (by omega : i < j - 1) he omega have hpredR : R < c + (j - 1) * e := by by_contra hle have hbound := prefix_le_top hprefix hpred (by omega) change c + (j - 1) * e ≤ z at hbound omega have hnext_eq : c + (i + 1) * e = z + e := by nlinarith only [hzi] have hjsub : j - 1 + 1 = j := by omega have hpred_eq : c + (j - 1) * e + e = v := by calc c + (j - 1) * e + e = c + (j - 1 + 1) * e := by ring _ = v := by rw [hjsub]; exact hvj omega theorem exists_coprime_in_prefix_core_linear {N c L R d h m : ℕ} (hcL : c < L) (hRN : R ≤ N) (hd : 0 < d) (hdL : d ≤ L) (hN : 16 * (L + N - R) ≤ N) (hRm : R < c + m * d) (hhalf : c + m * d + c ≤ 2 * (c + h * d)) : ∃ j : ℕ, L ≤ c + j * d ∧ j ≤ h ∧ Nat.Coprime j m := by have hRL : 16 * L ≤ R := by omega have hm6 : 6 ≤ m := by by_contra hlt have hmul := Nat.mul_le_mul_right d (by omega : m ≤ 5) omega obtain ⟨j, hjpos, hjm, hmj, hcop⟩ := exists_coprime_near_half m hm6 have hjh : j ≤ h := by by_contra hlt have hmul := Nat.mul_lt_mul_of_pos_right (by omega : 2 * h < m) hd nlinarith only [hmul, hhalf] have hjL : L ≤ c + j * d := by have hmul := Nat.mul_le_mul_right d hmj nlinarith only [hmul, hRm, hRL, hdL, hcL] exact ⟨j, hjL, hjh, hcop⟩ theorem exterior_witness_contradiction_linear {N c L R : ℕ} {S : Finset ℕ} (hcL : c < L) (hLR : L ≤ R) (hRN : R ≤ N) (hN : 16 * (L + N - R) ≤ N) (hsub : S ⊆ Finset.Icc 1 N) (hcrooked : IsCrooked S) (hc : c ∈ S) (hcorner : ∀ P, IsWitnessPair S c P → InExteriorCorner c L R P) (hbetween : ∀ u v : ℕ, u < v → IsWitnessPair S c {u, v} → ∃ x ∈ S, u < x ∧ x < v) : False := by obtain ⟨d, h, hd, hdL, hh, hmin, hprefix, htopR, htail⟩ := exterior_witness_prefix hcrooked hc hLR hcorner let z := c + h * d have hzS : z ∈ S := prefix_top_mem hprefix have hcz : c < z := by have hpos := Nat.mul_pos (by omega : 0 < h) hd dsimp [z] omega have hwide : 2 * L ≤ R + c := by omega have hzL : L ≤ z := prefix_reaches_core hd hh hprefix hmin htopR htail hwide hbetween have htopCover : ∀ v ∈ S, R < v → HasAPCover S {c, z, v} := by intro v hvS hRv have hzv : z < v := by dsimp [z]; omega apply hasAPCover_of_not_witness (by simp [hzv.ne]) · intro x hx simp only [Finset.mem_insert, Finset.mem_singleton] at hx rcases hx with rfl | rfl · exact Finset.mem_erase.mpr ⟨hcz.ne', hzS⟩ · exact Finset.mem_erase.mpr ⟨by omega, hvS⟩ · intro hW have hbad := (exterior_corner_pair_iff hLR hzv).mp (hcorner {z, v} hW) omega have hgrid : ∀ x ∈ S, d ∣ x - c := by intro x hx by_cases hxR : x ≤ R · exact prefix_dvd_offset hprefix hx hxR · exact (prefix_top_cover_analysis hd hh hprefix hmin htopR (by omega) (htopCover x hx (by omega))).1 have hSnonempty : S.Nonempty := ⟨c, hc⟩ let v := S.max' hSnonempty have hvS : v ∈ S := Finset.max'_mem S hSnonempty have hmax : ∀ x ∈ S, x ≤ v := fun x hx => Finset.le_max' S x hx have hRv : R < v := by obtain ⟨w, hwS, hRw⟩ := htail have hwv := hmax w hwS omega have hcv : c ≤ v := hmin v hvS have hvN : v ≤ N := (Finset.mem_Icc.mp (hsub hvS)).2 obtain ⟨m, hm⟩ := hgrid v hvS have hvm : v = c + m * d := by have hvsub := Nat.sub_add_cancel hcv nlinarith only [hm, hvsub] have hwideTail : 3 * v + c ≤ 4 * R := by omega have hhalf : v + c ≤ 2 * (c + h * d) := prefix_top_cover_half hd hh hprefix hmin hwideTail (htopCover v hvS hRv) obtain ⟨j, hjL, hjh, hjcop⟩ := exists_coprime_in_prefix_core_linear hcL hRN hd (by omega : d ≤ L) hN (by simpa only [hvm] using hRv) (by simpa only [hvm] using hhalf) let u := c + j * d have huR : u ≤ R := by have hmul := Nat.mul_le_mul_right d hjh dsimp [u] omega have huS : u ∈ S := by have hu : u ∈ S.filter (fun x => x ≤ R) := by rw [hprefix] exact mem_natAP.mpr ⟨j, by omega, rfl⟩ exact (Finset.mem_filter.mp hu).1 have hcu : c < u := by dsimp [u]; omega have huv : u < v := by omega have huCover : HasAPCover S {c, u, v} := by apply hasAPCover_of_not_witness (by simp [huv.ne]) · intro x hx simp only [Finset.mem_insert, Finset.mem_singleton] at hx rcases hx with rfl | rfl · exact Finset.mem_erase.mpr ⟨hcu.ne', huS⟩ · exact Finset.mem_erase.mpr ⟨by omega, hvS⟩ · intro hW have hbad := (exterior_corner_pair_iff hLR huv).mp (hcorner {u, v} hW) dsimp [u] at hbad omega obtain ⟨e, k, he, hk, hAS, huA, hvA⟩ := hasAPCover_at_min hmin hcu huCover have hde : d ∣ e := prefix_step_divides_cover_step hprefix he hAS hcu huA huR obtain ⟨i, hi, hui⟩ := mem_natAP.mp huA obtain ⟨i', hi', hvi'⟩ := mem_natAP.mp hvA have hejd : e ∣ j * d := by refine ⟨i, ?_⟩ dsimp [u] at hui nlinarith only [hui] have hemd : e ∣ m * d := by refine ⟨i', ?_⟩ rw [hvm] at hvi' nlinarith only [hvi'] have hed : e ∣ d := by have hdiv := Nat.dvd_gcd hejd hemd have hgcd : (j * d).gcd (m * d) = d := by rw [Nat.gcd_mul_right, hjcop.gcd_eq_one, Nat.one_mul] simpa only [hgcd] using hdiv have hedEq : e = d := Nat.dvd_antisymm hed hde have hvA' : v ∈ natAP c d k := by simpa only [hedEq] using hvA have hAS' : natAP c d k ⊆ S := by simpa only [hedEq] using hAS have hSA : S ⊆ natAP c d k := by obtain ⟨b, hb, hvb⟩ := mem_natAP.mp hvA' intro x hx obtain ⟨a, ha⟩ := hgrid x hx have hcx : c ≤ x := hmin x hx have hxa : x = c + a * d := by have hsubx := Nat.sub_add_cancel hcx nlinarith only [hsubx, ha] have hxab : a ≤ b := by have hxv := hmax x hx by_contra hab have hmul := Nat.mul_lt_mul_of_pos_right (by omega : b < a) hd omega exact mem_natAP.mpr ⟨a, lt_of_le_of_lt hxab hb, hxa.symm⟩ have hS_eq : S = natAP c d k := Finset.Subset.antisymm hSA hAS' exact hcrooked ⟨k, hS_eq.symm ▸ natAP_isAP hd⟩ theorem exists_witness_outside_exterior_pairs_linear {N c L R : ℕ} {S : Finset ℕ} {W : Finset (Finset ℕ)} (hcL : c < L) (hLR : L ≤ R) (hRN : R ≤ N) (hN : 16 * (L + N - R) ≤ N) (hsub : S ⊆ Finset.Icc 1 N) (hcrooked : IsCrooked S) (hc : c ∈ S) (hW : ∀ P ∈ W, InExteriorCorner c L R P) (hbetween : ∀ u v : ℕ, u < v → ({u, v} : Finset ℕ) ∈ W → ∃ x ∈ S, u < x ∧ x < v) : ∃ P : Finset ℕ, IsWitnessPair S c P ∧ P ∉ W := by by_contra hnone have hinW : ∀ P, IsWitnessPair S c P → P ∈ W := by intro P hP by_contra hPW exact hnone ⟨P, hP, hPW⟩ exact exterior_witness_contradiction_linear hcL hLR hRN hN hsub hcrooked hc (fun P hP => hW P (hinW P hP)) (fun u v huv hP => hbetween u v huv (hinW {u, v} hP)) end /- ProgressionCount -/ /- Counting intersecting arithmetic progressions by their common difference. -/ section open Finset theorem start_mem_same_step_of_inter {a b d k m x : ℕ} (hd : 0 < d) (hba : b ≤ a) (hx : x ∈ natAP a d k) (hx' : x ∈ natAP b d m) : a ∈ natAP b d m := by obtain ⟨i, hi, hxi⟩ := mem_natAP.mp hx obtain ⟨j, hj, hxj⟩ := mem_natAP.mp hx' have hij : i ≤ j := by by_contra hlt have hmul := Nat.mul_lt_mul_of_pos_right (by omega : j < i) hd omega have hsub : i + (j - i) = j := Nat.add_sub_of_le hij refine mem_natAP.mpr ⟨j - i, by omega, ?_⟩ nlinarith only [hxi, hxj, hsub] theorem same_step_common_point {N d : ℕ} {F : Finset (Finset ℕ)} (hd : 0 < d) (hF : Erdos272.IsArithInterSet N F) (hne : F.Nonempty) (hcard : ∀ S ∈ F, 0 < S.card) (hrep : ∀ S ∈ F, ∃ a : ℕ, S = natAP a d S.card) : ∃ c : ℕ, c ∈ Finset.Icc 1 N ∧ ∀ S ∈ F, c ∈ S := by classical let X := {S // S ∈ F} have hex : ∀ S : X, ∃ a : ℕ, S.val = natAP a d S.val.card := fun S => hrep S.val S.property choose a ha using hex have hX : (Finset.univ : Finset X).Nonempty := by obtain ⟨S, hS⟩ := hne exact ⟨⟨S, hS⟩, Finset.mem_univ _⟩ obtain ⟨S₀, hS₀, hmax⟩ := Finset.exists_max_image Finset.univ a hX have hc₀ : a S₀ ∈ S₀.val := by rw [ha S₀] exact mem_natAP.mpr ⟨0, hcard S₀.val S₀.property, by simp⟩ refine ⟨a S₀, (Finset.mem_powerset.mp (hF.1 S₀.property)) hc₀, ?_⟩ intro S hS let T : X := ⟨S, hS⟩ obtain ⟨x, hx⟩ := arithInter_inter_nonempty hF S₀.property hS ⟨a S₀, hc₀⟩ obtain ⟨hx₀, hxS⟩ := Finset.mem_inter.mp hx rw [ha S₀] at hx₀ have hxT : x ∈ natAP (a T) d T.val.card := by simpa only [← ha T] using hxS have hh := start_mem_same_step_of_inter hd (hmax T (Finset.mem_univ _)) hx₀ hxT simpa only [← ha T] using hh theorem centered_model_sharp_bounds {N c d : ℕ} {p : ProgressionCell} {S : Finset ℕ} (hd : 0 < d) (hmodel : IsCenteredModel c d p S) (hsub : S ⊆ Finset.Icc 1 N) : p.val.1 ≤ (c - 1) / d ∧ p.val.2 ≤ (N - c) / d := by have hl := centered_point_mem hmodel (Finset.mem_Icc.mpr ⟨le_rfl, (by omega : -(p.val.1 : ℤ) ≤ (p.val.2 : ℤ))⟩) have hr := centered_point_mem hmodel (Finset.mem_Icc.mpr ⟨(by omega : -(p.val.1 : ℤ) ≤ (p.val.2 : ℤ)), le_rfl⟩) have hlI := Finset.mem_Icc.mp (hsub hl.1) have hrI := Finset.mem_Icc.mp (hsub hr.1) have hleftI : (p.val.1 : ℤ) * (d : ℤ) + 1 ≤ c := by nlinarith only [hl.2, hlI.1] have hrightI : (p.val.2 : ℤ) * (d : ℤ) + c ≤ N := by nlinarith only [hr.2, hrI.2] have hleft : p.val.1 * d + 1 ≤ c := by exact_mod_cast hleftI have hright : p.val.2 * d + c ≤ N := by exact_mod_cast hrightI exact ⟨(Nat.le_div_iff_mul_le hd).mpr (by omega), (Nat.le_div_iff_mul_le hd).mpr (by omega)⟩ theorem centered_family_card_le_rectangle {N c d : ℕ} {F : Finset (Finset ℕ)} (hd : 0 < d) (hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N) (hmodel : ∀ S ∈ F, ∃ p : ProgressionCell, IsCenteredModel c d p S) : F.card ≤ ((c - 1) / d + 1) * ((N - c) / d + 1) := by classical let X := {S // S ∈ F} have hex : ∀ S : X, ∃ p : ProgressionCell, IsCenteredModel c d p S.val := fun S => hmodel S.val S.property choose p hp using hex let f : X → ℕ × ℕ := fun S => (p S).val have hinj : Function.Injective f := by intro S T hST have hpST : p S = p T := Subtype.ext hST apply Subtype.ext exact centered_model_determines_set (hp S) (by simpa only [hpST] using hp T) have hmaps : Set.MapsTo f ((Finset.univ : Finset X) : Set X) (((Finset.range ((c - 1) / d + 1)).product (Finset.range ((N - c) / d + 1))) : Set (ℕ × ℕ)) := by intro S hS have hb := centered_model_sharp_bounds hd (hp S) (hsub S.val S.property) exact Finset.mem_product.mpr ⟨Finset.mem_range.mpr (by dsimp [f]; omega), Finset.mem_range.mpr (by dsimp [f]; omega)⟩ simpa [X] using Finset.card_le_card_of_injOn f hmaps hinj.injOn theorem same_step_family_card_le {N d : ℕ} {F : Finset (Finset ℕ)} (hd : 0 < d) (hF : Erdos272.IsArithInterSet N F) (hcard : ∀ S ∈ F, 4 ≤ S.card) (hrep : ∀ S ∈ F, ∃ a : ℕ, S = natAP a d S.card) : (F.card : ℝ) ≤ (N : ℝ) ^ 2 / (4 * (d : ℝ) ^ 2) + (N : ℝ) / d + 1 := by classical by_cases hne : F.Nonempty · obtain ⟨c, hcN, hc⟩ := same_step_common_point hd hF hne (fun S hS => by have hh := hcard S hS; omega) hrep have hmodels : ∀ S ∈ F, ∃ p : ProgressionCell, IsCenteredModel c d p S := by intro S hS obtain ⟨a, heq⟩ := hrep S hS obtain ⟨i, hi, hci⟩ := mem_natAP.mp (heq ▸ hc S hS) refine ⟨⟨(i, S.card - 1 - i), by have hh := hcard S hS; omega⟩, ?_⟩ change S.image (fun x : ℕ => (x : ℤ)) = _ have hcast := congrArg (fun T : Finset ℕ => T.image (fun x : ℕ => (x : ℤ))) heq exact hcast.trans (by simpa only [hci] using natAP_cast_eq_affine_interval a d S.card i hi) have hbound := centered_family_card_le_rectangle hd (fun S hS => Finset.mem_powerset.mp (hF.1 hS)) hmodels let C := (c - 1) / d let M := (N - c) / d have hCM : (C + M) * d ≤ N := by have hC := Nat.div_mul_le_self (c - 1) d have hM := Nat.div_mul_le_self (N - c) d obtain ⟨hc1, hcN'⟩ := Finset.mem_Icc.mp hcN dsimp [C, M] nlinarith only [hC, hM, Nat.sub_add_cancel hc1, Nat.sub_add_cancel hcN'] have hdR : (0 : ℝ) < d := by exact_mod_cast hd have hsum : (C : ℝ) + M ≤ (N : ℝ) / d := by apply (le_div_iff₀ hdR).mpr exact_mod_cast hCM have hboundR : (F.card : ℝ) ≤ ((C : ℝ) + 1) * ((M : ℝ) + 1) := by exact_mod_cast hbound have hsq : ((C : ℝ) + M + 2) ^ 2 ≤ ((N : ℝ) / d + 2) ^ 2 := (sq_le_sq₀ (by positivity) (by positivity)).mpr (by linarith only [hsum]) have hid : ((N : ℝ) / d + 2) ^ 2 / 4 = (N : ℝ) ^ 2 / (4 * (d : ℝ) ^ 2) + (N : ℝ) / d + 1 := by field_simp ring nlinarith only [hboundR, hsq, hid, sq_nonneg ((C : ℝ) - M)] · have hF0 : F = ∅ := Finset.not_nonempty_iff_eq_empty.mp hne rw [hF0] simp only [Finset.card_empty, Nat.cast_zero] positivity theorem reciprocal_square_sum_le (N : ℕ) : (∑ i ∈ Finset.Icc 1 N, ((i : ℝ) ^ 2)⁻¹) ≤ 5 / 3 := by have hsmall : (∑ i ∈ Finset.Icc (1 : ℕ) 5, ((i : ℝ) ^ 2)⁻¹) = 5269 / 3600 := by norm_num [Finset.sum_Icc_succ_top] by_cases hN : 5 ≤ N · have hsplit : Finset.Icc 1 N = Finset.Icc 1 5 ∪ Finset.Ioc 5 N := by ext i simp only [Finset.mem_Icc, Finset.mem_union, Finset.mem_Ioc] omega have hdisj : Disjoint (Finset.Icc 1 5) (Finset.Ioc 5 N) := by apply Finset.disjoint_left.mpr intro i hi hi' simp only [Finset.mem_Icc, Finset.mem_Ioc] at hi hi' omega rw [hsplit, Finset.sum_union hdisj, hsmall] have htail := sum_Ioc_inv_sq_le_sub (α := ℝ) (k := 5) (by decide) hN have hpos : 0 ≤ (N : ℝ)⁻¹ := by positivity norm_num only at htail linarith only [htail, hpos] · calc _ ≤ ∑ i ∈ Finset.Icc (1 : ℕ) 5, ((i : ℝ) ^ 2)⁻¹ := by apply Finset.sum_le_sum_of_subset_of_nonneg · intro i hi obtain ⟨hi1, hiN⟩ := Finset.mem_Icc.mp hi exact Finset.mem_Icc.mpr ⟨hi1, by omega⟩ · intro i hi hi' positivity _ ≤ 5 / 3 := by rw [hsmall]; norm_num theorem progression_family_large_card_le {N : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hcard : ∀ S ∈ F, 4 ≤ S.card) : (F.card : ℝ) ≤ 5 * (N : ℝ) ^ 2 / 12 + (N : ℝ) * reciprocalSum N + N := by classical have hparam : ∀ S : Finset ℕ, ∃ a d : ℕ, S ∈ F → 0 < d ∧ d ≤ N ∧ S = natAP a d S.card := by intro S by_cases hS : S ∈ F · obtain ⟨l, hl⟩ := hAP S hS obtain ⟨a, d, hd, hrep⟩ := nat_ap_eq_natAP hl (by have hh := hcard S hS; omega) have hstep : a + d ∈ S := by rw [hrep] exact mem_natAP.mpr ⟨1, by have hh := hcard S hS; omega, by simp⟩ have hdN : d ≤ N := by have hh := (Finset.mem_Icc.mp ((Finset.mem_powerset.mp (hF.1 hS)) hstep)).2 omega exact ⟨a, d, fun _ => ⟨hd, hdN, hrep⟩⟩ · exact ⟨0, 1, fun h => False.elim (hS h)⟩ choose a d hspec using hparam have hmaps : Set.MapsTo d (F : Set (Finset ℕ)) (Finset.Icc 1 N : Set ℕ) := by intro S hS exact Finset.mem_Icc.mpr ⟨(hspec S hS).1, (hspec S hS).2.1⟩ have hsumCard : (F.card : ℝ) = ∑ k ∈ Finset.Icc 1 N, ((F.filter (fun S => d S = k)).card : ℝ) := by exact_mod_cast Finset.card_eq_sum_card_fiberwise hmaps have hbound : ∀ k ∈ Finset.Icc 1 N, ((F.filter (fun S => d S = k)).card : ℝ) ≤ (N : ℝ) ^ 2 / (4 * (k : ℝ) ^ 2) + (N : ℝ) / k + 1 := by intro k hk apply same_step_family_card_le (Finset.mem_Icc.mp hk).1 · exact ⟨fun S hS => hF.1 (Finset.mem_filter.mp hS).1, fun S hS T hT hST => hF.2 (Finset.mem_filter.mp hS).1 (Finset.mem_filter.mp hT).1 hST⟩ · intro S hS exact hcard S (Finset.mem_filter.mp hS).1 · intro S hS obtain ⟨hSF, hdk⟩ := Finset.mem_filter.mp hS exact ⟨a S, by simpa only [hdk] using (hspec S hSF).2.2⟩ calc (F.card : ℝ) ≤ ∑ k ∈ Finset.Icc 1 N, ((N : ℝ) ^ 2 / (4 * (k : ℝ) ^ 2) + (N : ℝ) / k + 1) := by rw [hsumCard] exact Finset.sum_le_sum hbound _ = (N : ℝ) ^ 2 / 4 * (∑ k ∈ Finset.Icc 1 N, ((k : ℝ) ^ 2)⁻¹) + (N : ℝ) * reciprocalSum N + N := by calc _ = ∑ k ∈ Finset.Icc 1 N, ((N : ℝ) ^ 2 / 4 * ((k : ℝ) ^ 2)⁻¹ + (N : ℝ) * (k : ℝ)⁻¹ + 1) := by apply Finset.sum_congr rfl intro k hk simp only [div_eq_mul_inv, mul_inv_rev] ring _ = _ := by simp [reciprocalSum, Finset.sum_add_distrib, ← Finset.mul_sum] _ ≤ 5 * (N : ℝ) ^ 2 / 12 + (N : ℝ) * reciprocalSum N + N := by have hh := mul_le_mul_of_nonneg_left (reciprocal_square_sum_le N) (by positivity : 0 ≤ (N : ℝ) ^ 2 / 4) nlinarith only [hh] theorem progression_family_large_card_le_log {N : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hcard : ∀ S ∈ F, 4 ≤ S.card) : (F.card : ℝ) ≤ 5 * (N : ℝ) ^ 2 / 12 + (N : ℝ) * Real.log N + 2 * N := by have h := progression_family_large_card_le hF hAP hcard have hlog := mul_le_mul_of_nonneg_left (reciprocalSum_le_log N) (Nat.cast_nonneg N) nlinarith only [h, hlog] end /- SmallProgressionCount -/ /- Small progression members contribute only a linear error to the progression count. -/ section open Finset theorem admissible_subfamily {N : ℕ} {F G : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hGF : G ⊆ F) : Erdos272.IsArithInterSet N G := ⟨fun _S hS => hF.1 (hGF hS), fun _S hS _T hT hST => hF.2 (hGF hS) (hGF hT) hST⟩ theorem short_progressions_rooted_card_le {N c : ℕ} {F : Finset (Finset ℕ)} (hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hcard : ∀ S ∈ F, 2 ≤ S.card ∧ S.card ≤ 3) (hc : ∀ S ∈ F, c ∈ S) : F.card ≤ 6 * N := by classical let X := {S // S ∈ F} have hparam : ∀ S : X, ∃ d i : ℕ, 0 < d ∧ d ≤ N ∧ i < S.val.card ∧ S.val = natAP (c - i * d) d S.val.card := by intro S obtain ⟨l, hl⟩ := hAP S.val S.property obtain ⟨a, d, hd, hrep⟩ := nat_ap_eq_natAP hl (hcard S.val S.property).1 obtain ⟨i, hi, hci⟩ := mem_natAP.mp (hrep ▸ hc S.val S.property) have ha : a = c - i * d := by omega have hstep : a + d ∈ S.val := by rw [hrep] exact mem_natAP.mpr ⟨1, (hcard S.val S.property).1, by simp⟩ have hdN : d ≤ N := by have hh := (Finset.mem_Icc.mp (hsub S.val S.property hstep)).2 omega exact ⟨d, i, hd, hdN, hi, by simpa only [ha] using hrep⟩ choose d i hd hdN hi hrep using hparam let f : X → ℕ × ℕ × ℕ := fun S => (S.val.card, i S, d S) have hinj : Function.Injective f := by intro S T hST have hk : S.val.card = T.val.card := congrArg Prod.fst hST have hiST : i S = i T := congrArg (fun q : ℕ × ℕ × ℕ => q.2.1) hST have hdST : d S = d T := congrArg (fun q : ℕ × ℕ × ℕ => q.2.2) hST apply Subtype.ext rw [hrep S, hrep T, hk, hiST, hdST] have hmaps : Set.MapsTo f ((Finset.univ : Finset X) : Set X) (((Finset.Icc 2 3).product ((Finset.range 3).product (Finset.Icc 1 N))) : Set (ℕ × ℕ × ℕ)) := by intro S hS have hsize := hcard S.val S.property dsimp only [f] exact Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr hsize, Finset.mem_product.mpr ⟨Finset.mem_range.mpr (show i S < 3 by have hh := hi S; omega), Finset.mem_Icc.mpr ⟨hd S, hdN S⟩⟩⟩ have hh := Finset.card_le_card_of_injOn f hmaps hinj.injOn norm_num [X, Finset.card_product] at hh omega theorem singleton_of_member_card_le_one {S : Finset ℕ} {c : ℕ} (hc : c ∈ S) (hcard : S.card ≤ 1) : S = {c} := by apply Finset.Subset.antisymm · intro x hx exact Finset.mem_singleton.mpr (Finset.card_le_one.mp hcard x hx c hc) · simpa only [Finset.singleton_subset_iff] using hc theorem small_progressions_rooted_card_le {N c : ℕ} {F : Finset (Finset ℕ)} (hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hcard : ∀ S ∈ F, S.card ≤ 3) (hc : ∀ S ∈ F, c ∈ S) : F.card ≤ 6 * N + 1 := by classical have hlarge : (F.filter (fun S => 2 ≤ S.card)).card ≤ 6 * N := by apply short_progressions_rooted_card_le · intro S hS exact hsub S (Finset.mem_filter.mp hS).1 · intro S hS exact hAP S (Finset.mem_filter.mp hS).1 · intro S hS obtain ⟨hSF, hsize⟩ := Finset.mem_filter.mp hS exact ⟨hsize, hcard S hSF⟩ · intro S hS exact hc S (Finset.mem_filter.mp hS).1 have hsmall : (F.filter (fun S => ¬2 ≤ S.card)).card ≤ 1 := by apply Finset.card_le_one.mpr intro S hS T hT obtain ⟨hSF, hsizeS⟩ := Finset.mem_filter.mp hS obtain ⟨hTF, hsizeT⟩ := Finset.mem_filter.mp hT rw [singleton_of_member_card_le_one (hc S hSF) (by omega), singleton_of_member_card_le_one (hc T hTF) (by omega)] have hpart := Finset.card_filter_add_card_filter_not (s := F) (fun S => 2 ≤ S.card) omega theorem progression_family_small_card_le {N : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hcard : ∀ S ∈ F, S.card ≤ 3) : F.card ≤ 18 * N + 3 := by classical by_cases hne : ∃ S ∈ F, S.Nonempty · obtain ⟨S₀, hS₀, hne₀⟩ := hne let D (c : ℕ) := F.filter (fun S => c ∈ S) have hcover : F ⊆ S₀.biUnion D := by intro S hS obtain ⟨c, hc⟩ := arithInter_inter_nonempty hF hS₀ hS hne₀ obtain ⟨hc₀, hcS⟩ := Finset.mem_inter.mp hc exact Finset.mem_biUnion.mpr ⟨c, hc₀, Finset.mem_filter.mpr ⟨hS, hcS⟩⟩ have hD : ∀ c ∈ S₀, (D c).card ≤ 6 * N + 1 := by intro c hc apply small_progressions_rooted_card_le · intro S hS exact Finset.mem_powerset.mp (hF.1 (Finset.mem_filter.mp hS).1) · intro S hS exact hAP S (Finset.mem_filter.mp hS).1 · intro S hS exact hcard S (Finset.mem_filter.mp hS).1 · intro S hS exact (Finset.mem_filter.mp hS).2 calc F.card ≤ (S₀.biUnion D).card := Finset.card_le_card hcover _ ≤ ∑ c ∈ S₀, (D c).card := Finset.card_biUnion_le _ ≤ ∑ c ∈ S₀, (6 * N + 1) := Finset.sum_le_sum hD _ = S₀.card * (6 * N + 1) := by simp _ ≤ 18 * N + 3 := by have hh := Nat.mul_le_mul_right (6 * N + 1) (hcard S₀ hS₀) omega · have hsmall : F.card ≤ 1 := by apply Finset.card_le_one.mpr intro S hS T hT have hS0 : S = ∅ := Finset.not_nonempty_iff_eq_empty.mp (fun hh => hne ⟨S, hS, hh⟩) have hT0 : T = ∅ := Finset.not_nonempty_iff_eq_empty.mp (fun hh => hne ⟨T, hT, hh⟩) rw [hS0, hT0] omega theorem progression_family_card_le {N : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) : (F.card : ℝ) ≤ 5 * (N : ℝ) ^ 2 / 12 + (N : ℝ) * Real.log N + 20 * N + 3 := by classical have hbig : ((F.filter (fun S => 4 ≤ S.card)).card : ℝ) ≤ 5 * (N : ℝ) ^ 2 / 12 + (N : ℝ) * Real.log N + 2 * N := by apply progression_family_large_card_le_log · exact admissible_subfamily hF (Finset.filter_subset _ _) · intro S hS exact hAP S (Finset.mem_filter.mp hS).1 · intro S hS exact (Finset.mem_filter.mp hS).2 have hsmall : (F.filter (fun S => ¬4 ≤ S.card)).card ≤ 18 * N + 3 := by apply progression_family_small_card_le · exact admissible_subfamily hF (Finset.filter_subset _ _) · intro S hS exact hAP S (Finset.mem_filter.mp hS).1 · intro S hS have hh := (Finset.mem_filter.mp hS).2 omega have hpart : ((F.filter (fun S => 4 ≤ S.card)).card : ℝ) + ((F.filter (fun S => ¬4 ≤ S.card)).card : ℝ) = F.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := F) (fun S => 4 ≤ S.card) have hsmallR : ((F.filter (fun S => ¬4 ≤ S.card)).card : ℝ) ≤ 18 * (N : ℝ) + 3 := by exact_mod_cast hsmall linarith only [hbig, hsmallR, hpart] end /- ProgressionAsymptotic -/ /- Uniform asymptotic consequences of the progression-family count. -/ section open Finset Filter noncomputable def crookedMembers (F : Finset (Finset ℕ)) : Finset (Finset ℕ) := by classical exact F.filter IsCrooked theorem eventually_progression_family_quadratic_gap : ∀ᶠ N : ℕ in Filter.atTop, ∀ F : Finset (Finset ℕ), Erdos272.IsArithInterSet N F → (∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) → (F.card : ℝ) ≤ 17 / 40 * (N : ℝ) ^ 2 := by have hlog := Real.isLittleO_log_id_atTop.bound (by norm_num : (0 : ℝ) < 1 / 240) have hnat : ∀ᶠ N : ℕ in atTop, ‖Real.log (N : ℝ)‖ ≤ (1 / 240 : ℝ) * ‖(N : ℝ)‖ := (tendsto_natCast_atTop_atTop : Tendsto (fun N : ℕ => (N : ℝ)) atTop atTop).eventually hlog filter_upwards [hnat, Filter.eventually_ge_atTop 10000] with N hlogN hN F hF hAP have hcount := progression_family_card_le hF hAP have hNR : (10000 : ℝ) ≤ N := by exact_mod_cast hN have hnonneg : (0 : ℝ) ≤ N := Nat.cast_nonneg N have hln : Real.log (N : ℝ) ≤ (1 / 240 : ℝ) * N := by simp only [Real.norm_eq_abs, abs_of_nonneg hnonneg] at hlogN exact (le_abs_self _).trans hlogN have hlnmul := mul_le_mul_of_nonneg_left hln hnonneg have hNsq := mul_le_mul_of_nonneg_left hNR hnonneg nlinarith only [hcount, hlnmul, hNsq, hNR] theorem eventually_many_crooked_members : ∀ᶠ N : ℕ in Filter.atTop, ∀ F : Finset (Finset ℕ), Erdos272.IsArithInterSet N F → (N : ℝ) ^ 2 / 2 ≤ (F.card : ℝ) → 3 / 40 * (N : ℝ) ^ 2 ≤ ((crookedMembers F).card : ℝ) := by classical filter_upwards [eventually_progression_family_quadratic_gap] with N hN F hF hsize have hAP : ∀ S ∈ F.filter (fun S => ¬IsCrooked S), ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l := by intro S hS simpa only [IsCrooked, not_not] using (Finset.mem_filter.mp hS).2 have hcount := hN _ (admissible_subfamily hF (Finset.filter_subset _ _)) hAP have hpart : ((F.filter IsCrooked).card : ℝ) + ((F.filter (fun S => ¬IsCrooked S)).card : ℝ) = F.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := F) IsCrooked change 3 / 40 * (N : ℝ) ^ 2 ≤ ((F.filter IsCrooked).card : ℝ) linarith only [hcount, hpart, hsize] noncomputable def sparseCrookedMembers (N : ℕ) (F : Finset (Finset ℕ)) : Finset (Finset ℕ) := by classical exact (crookedMembers F).filter (fun S => 16 * S.card ≤ N) theorem eventually_many_sparse_crooked_members : ∀ᶠ N : ℕ in Filter.atTop, ∀ F : Finset (Finset ℕ), Erdos272.IsArithInterSet N F → (N : ℝ) ^ 2 / 2 ≤ (F.card : ℝ) → (N : ℝ) ^ 2 / 14 ≤ ((sparseCrookedMembers N F).card : ℝ) := by classical filter_upwards [eventually_many_crooked_members, Filter.eventually_ge_atTop 1000000] with N hN hlarge F hF hsize let C := crookedMembers F let D := C.filter (fun S => ¬16 * S.card ≤ N) have hcount : 3 / 40 * (N : ℝ) ^ 2 ≤ (C.card : ℝ) := hN F hF hsize have hDF : D ⊆ F := by intro S hS have hSC : S ∈ C := (Finset.mem_filter.mp hS).1 exact (Finset.mem_filter.mp hSC).1 have hdense : D.card ≤ 2048 * N := by apply dense_crooked_card_le (by omega) (admissible_subfamily hF hDF) · intro S hS have hSC : S ∈ C := (Finset.mem_filter.mp hS).1 exact (Finset.mem_filter.mp hSC).2 · intro S hS have hh := (Finset.mem_filter.mp hS).2 omega have hpart : ((sparseCrookedMembers N F).card : ℝ) + (D.card : ℝ) = C.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := C) (fun S => 16 * S.card ≤ N) have hdenseR : (D.card : ℝ) ≤ 2048 * (N : ℝ) := by exact_mod_cast hdense have hNR : (1000000 : ℝ) ≤ N := by exact_mod_cast hlarge have hproduct := mul_le_mul_of_nonneg_left hNR (Nat.cast_nonneg N : (0 : ℝ) ≤ N) nlinarith only [hcount, hdenseR, hpart, hproduct] end /- TracePreparation -/ /- Divisor-minimal traces, their prefixes, and simultaneous witness counts. -/ section open Finset theorem minimal_trace_witness_core_consecutive {S : Finset ℕ} {c p d : ℕ} (hcp : c < p) (hd : 0 < d) (hddiv : d ∣ p - c) (htrace : apSegment c p d ⊆ S) (hmin : ∀ e : ℕ, 0 < e → e ∣ d → apSegment c p e ⊆ S → d ≤ e) : ∃ U : Finset ℕ, U ⊆ S ∧ (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) ∧ ConsecutiveIn U c (c + d) ∧ apSegment c p d ⊆ U ∧ ∀ z ∈ S, p ≤ z → z ∉ U → ∀ i : ℕ, 0 < i → c + i * d ∈ U → i.Coprime (anchorDistance c z) → IsWitnessPair S c {c + i * d, z} := by have hdlen : d ≤ p - c := Nat.le_of_dvd (by omega) hddiv have hcT : c ∈ apSegment c p d := Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨le_rfl, hcp.le⟩, by simp⟩ have hvT : c + d ∈ apSegment c p d := Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨by omega, by omega⟩, by simp⟩ have hrep := apSegment_eq_natAP hcp.le hd have hTcon : ConsecutiveIn (apSegment c p d) c (c + d) := hrep.symm ▸ natAP_consecutive_of_neighbor hd (hrep ▸ hcT) (hrep ▸ hvT) obtain ⟨U, hUS, hUAP, hUcon, hmax⟩ := fixedGap_core (by omega : c < c + d) (htrace hcT) (htrace hvT) have hTU : apSegment c p d ⊆ U := hmax _ htrace (Or.inr ⟨apSegment_isAP hcp.le hd, hTcon⟩) refine ⟨U, hUS, hUAP, hUcon, hTU, ?_⟩ intro z hz hpz hzU i hi hyU hcop let y := c + i * d have hcy : c < y := by dsimp [y]; nlinarith only [hi, hd] have hzc : z ≠ c := by omega have hyz : y ≠ z := fun heq => hzU (heq ▸ hyU) refine ⟨Finset.card_pair hyz, ?_, ?_⟩ · intro x hx simp only [Finset.mem_insert, Finset.mem_singleton] at hx rcases hx with rfl | rfl · exact Finset.mem_erase.mpr ⟨hcy.ne', hUS hyU⟩ · exact Finset.mem_erase.mpr ⟨hzc, hz⟩ · rintro ⟨A, hAS, ⟨l, hAAP⟩, hCA⟩ have hcA : c ∈ A := hCA (by simp) have hyA : y ∈ A := hCA (by simp [y]) have hzA : z ∈ A := hCA (by simp) have hcard : 2 ≤ A.card := by have hsub : {c, y} ⊆ A := by simp [Finset.insert_subset_iff, hcA, hyA] simpa [hcy.ne] using Finset.card_le_card hsub obtain ⟨a, e, he, hArep⟩ := nat_ap_eq_natAP hAAP hcard have heid : e ∣ i * d := by have hh := natAP_dvd_anchorDistance (hArep ▸ hcA) (hArep ▸ hyA) have hdist : anchorDistance c y = i * d := by dsimp [anchorDistance, y]; omega simpa only [hdist] using hh have hez : e ∣ anchorDistance c z := natAP_dvd_anchorDistance (hArep ▸ hcA) (hArep ▸ hzA) have hed : e ∣ d := ((hcop.of_dvd_right hez).symm).dvd_of_dvd_mul_left heid have hediv : e ∣ p - c := hed.trans hddiv have hTeA : apSegment c p e ⊆ A := by rw [apSegment_eq_natAP hcp.le he] have hlast : c + ((p - c) / e) * e ≤ z := by rw [Nat.div_mul_cancel hediv] omega exact (natAP_prefix_subset_of_endpoints he (hArep ▸ hcA) (hArep ▸ hzA) hlast).trans (by rw [← hArep]) have hde : d ≤ e := hmin e he hed (hTeA.trans hAS) have hed' : e ≤ d := Nat.le_of_dvd hd hed have heq : e = d := by omega have hvAe : c + e ∈ A := hTeA (by simpa only [heq] using hvT) have hcon : ConsecutiveIn A c (c + d) := by have hh := natAP_consecutive_of_neighbor he (hArep ▸ hcA) (hArep ▸ hvAe) have hhA : ConsecutiveIn A c (c + e) := hArep.symm ▸ hh simpa only [heq] using hhA exact hzU (hmax A hAS (Or.inr ⟨⟨l, hAAP⟩, hcon⟩) hzA) end /- Exact right-hand prefixes of finite arithmetic progressions through a fixed gap. -/ section open Finset theorem card_natAP {a d k : ℕ} (hd : 0 < d) : (natAP a d k).card = k := by have hinj : Function.Injective (fun i : ℕ => a + i * d) := by intro i j hij nlinarith only [hij, hd] rw [natAP, Finset.card_image_of_injective _ hinj, Finset.card_range] theorem ap_right_prefix_of_consecutive {U : Finset ℕ} {c d : ℕ} (hd : 0 < d) (hAP : ∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) (hcon : ConsecutiveIn U c (c + d)) : ∃ k : ℕ, 1 ≤ k ∧ U.filter (fun x => c ≤ x) = natAP c d (k + 1) := by obtain ⟨l, hl⟩ := hAP obtain ⟨a, hU⟩ := nat_ap_eq_with_consecutive_gap hl hcon simp only [Nat.add_sub_cancel_left] at hU have hne : U.Nonempty := ⟨c, hcon.1⟩ let v := U.max' hne have hvU : v ∈ U := Finset.max'_mem U hne have hcv : c ≤ v := Finset.le_max' U c hcon.1 have hvd : c + d ≤ v := Finset.le_max' U (c + d) hcon.2.1 have hfilter : U.filter (fun x => c ≤ x) = U ∩ Finset.Icc c v := by ext x simp only [Finset.mem_filter, Finset.mem_inter, Finset.mem_Icc] constructor · rintro ⟨hx, hcx⟩ exact ⟨hx, hcx, Finset.le_max' U x hx⟩ · rintro ⟨hx, hcx, _⟩ exact ⟨hx, hcx⟩ have hslice : U ∩ Finset.Icc c v = apSegment c v d := (congrArg (fun T : Finset ℕ => T ∩ Finset.Icc c v) hU).trans (natAP_inter_Icc_eq_segment hd (hU ▸ hcon.1) (hU ▸ hvU) hcv) refine ⟨(v - c) / d, ?_, ?_⟩ · apply (Nat.le_div_iff_mul_le hd).mpr omega · rw [hfilter, hslice, apSegment_eq_natAP hcv hd] theorem right_prefix_card_le_of_no_long_prefix {S U : Finset ℕ} {c d K : ℕ} (hd : 0 < d) (hUS : U ⊆ S) (hAP : ∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) (hcon : ConsecutiveIn U c (c + d)) (hno : ∀ e : ℕ, 0 < e → ¬ natAP c e (K + 1) ⊆ S) : (U.filter (fun x => c ≤ x)).card ≤ K := by obtain ⟨k, hk, hprefix⟩ := ap_right_prefix_of_consecutive hd hAP hcon have hkK : k < K := by by_contra hnot have hKk : K ≤ k := by omega apply hno d hd have hsub : natAP c d (K + 1) ⊆ natAP c d (k + 1) := by intro x hx obtain ⟨i, hi, hxi⟩ := mem_natAP.mp hx exact mem_natAP.mpr ⟨i, by omega, hxi⟩ exact hsub.trans (hprefix ▸ (Finset.filter_subset _ _).trans hUS) rw [hprefix, card_natAP hd] omega end /- Arithmetic bounds for products of two anchor distances. -/ section open Filter theorem eventually_uniform_divisor_card_pow_le_square (k : ℕ) : ∀ᶠ N : ℕ in Filter.atTop, ∀ m ≤ N^2, m.divisors.card^k ≤ N := by have ht : Tendsto (fun N : ℕ => N^2) atTop atTop := by apply Filter.tendsto_atTop.mpr intro b filter_upwards [Filter.eventually_ge_atTop b] with N hN nlinarith only [hN] have hh := ht.eventually (eventually_uniform_divisor_card_pow_le (2*k)) filter_upwards [hh] with N hN m hm have hsq : (m.divisors.card^k)^2 ≤ N^2 := by simpa only [pow_mul, Nat.mul_comm 2 k] using hN m hm nlinarith only [hsq] theorem natLog_succ_le_twice_of_le_square {m N : ℕ} (hm : m ≤ N^2) : Nat.log 2 m + 1 ≤ 2 * (Nat.log 2 N + 1) := by let L := Nat.log 2 N + 1 have hL : 1 ≤ L := by dsimp [L]; omega have hN : N < 2^L := Nat.lt_pow_succ_log_self (b := 2) (by decide) N have hsq : N^2 < (2^L)^2 := by nlinarith only [hN] have heq : (2^L)^2 = 2^(2*L) := by rw [← pow_mul, Nat.mul_comm L 2] rw [heq] at hsq have hlog := Nat.log_lt_of_lt_pow' (b := 2) (by omega : 2*L ≠ 0) (hm.trans_lt hsq) omega end /- Divisor-minimal endpoint traces cover every point except structural witness neighbors. -/ section open Finset noncomputable def witnessNeighbors (S : Finset ℕ) (c p : ℕ) : Finset ℕ := by classical exact S.filter (fun x => IsWitnessPair S c {p, x}) def traceSteps (S : Finset ℕ) (c p : ℕ) : Finset ℕ := (p - c).divisors.filter (fun d => apSegment c p d ⊆ S) noncomputable def minimalTraceSteps (S : Finset ℕ) (c p : ℕ) : Finset ℕ := by classical exact (traceSteps S c p).filter (fun d => ∀ e : ℕ, 0 < e → e ∣ d → apSegment c p e ⊆ S → d ≤ e) theorem minimalTraceSteps_card_le (S : Finset ℕ) (c p : ℕ) : (minimalTraceSteps S c p).card ≤ (p - c).divisors.card := by classical exact Finset.card_le_card ((Finset.filter_subset _ _).trans (Finset.filter_subset _ _)) theorem minimal_trace_union_subset (S : Finset ℕ) (c p : ℕ) : (minimalTraceSteps S c p).biUnion (apSegment c p) ⊆ S := by classical intro x hx obtain ⟨d, hd, hxd⟩ := Finset.mem_biUnion.mp hx exact (Finset.mem_filter.mp (Finset.mem_filter.mp hd).1).2 hxd theorem trace_union_subset_minimal (S : Finset ℕ) {c p : ℕ} (hcp : c < p) : (traceSteps S c p).biUnion (apSegment c p) ⊆ (minimalTraceSteps S c p).biUnion (apSegment c p) := by classical intro x hx obtain ⟨d, hd, hxd⟩ := Finset.mem_biUnion.mp hx obtain ⟨hddiv, hdS⟩ := Finset.mem_filter.mp hd obtain ⟨e, he, hed, heS, hmin⟩ := exists_divisor_minimal_trace (Nat.pos_of_mem_divisors hddiv) hdS have heM : e ∈ minimalTraceSteps S c p := Finset.mem_filter.mpr ⟨Finset.mem_filter.mpr ⟨Nat.mem_divisors.mpr ⟨hed.trans (Nat.mem_divisors.mp hddiv).1, by omega⟩, heS⟩, hmin⟩ exact Finset.mem_biUnion.mpr ⟨e, heM, apSegment_mono_step hed hxd⟩ theorem hasAPCover_triple_of_not_witness {S : Finset ℕ} {c p x : ℕ} (hcp : c < p) (hc : c ∈ S) (hp : p ∈ S) (hx : x ∈ S) (hnot : ¬ IsWitnessPair S c {p, x}) : HasAPCover S {c, p, x} := by by_cases hxc : x = c · subst x refine ⟨{c, p}, by simp [Finset.insert_subset_iff, hc, hp], ⟨2, by simpa using Nat.isAPOfLength_pair hcp⟩, ?_⟩ simp [Finset.insert_subset_iff] by_cases hxp : x = p · subst x refine ⟨{c, p}, by simp [Finset.insert_subset_iff, hc, hp], ⟨2, by simpa using Nat.isAPOfLength_pair hcp⟩, ?_⟩ simp apply hasAPCover_of_not_witness (Finset.card_pair (Ne.symm hxp)) · intro y hy simp only [Finset.mem_insert, Finset.mem_singleton] at hy rcases hy with rfl | rfl · exact Finset.mem_erase.mpr ⟨hcp.ne', hp⟩ · exact Finset.mem_erase.mpr ⟨hxc, hx⟩ · exact hnot theorem covered_point_mem_trace_union {S : Finset ℕ} {c p x : ℕ} (hcp : c < p) (hx : x ∈ Finset.Icc c p) (hcover : HasAPCover S {c, p, x}) : x ∈ (traceSteps S c p).biUnion (apSegment c p) := by obtain ⟨A, hAS, hAP, hCA⟩ := hcover obtain ⟨d, hd, hddiv, htrace⟩ := ap_inter_Icc_endpoints hAP (hCA (by simp)) (hCA (by simp)) hcp have hdS : apSegment c p d ⊆ S := by rw [← htrace] exact Finset.inter_subset_left.trans hAS have hdD : d ∈ traceSteps S c p := Finset.mem_filter.mpr ⟨Nat.mem_divisors.mpr ⟨hddiv, by omega⟩, hdS⟩ exact Finset.mem_biUnion.mpr ⟨d, hdD, htrace ▸ Finset.mem_inter.mpr ⟨hCA (by simp), hx⟩⟩ theorem trace_cover_by_minimal_and_neighbors {S : Finset ℕ} {c p : ℕ} (hcp : c < p) (hc : c ∈ S) (hp : p ∈ S) : S ∩ Finset.Icc c p ⊆ (minimalTraceSteps S c p).biUnion (apSegment c p) ∪ witnessNeighbors S c p := by classical intro x hx obtain ⟨hxS, hxI⟩ := Finset.mem_inter.mp hx by_cases hW : IsWitnessPair S c {p, x} · exact Finset.mem_union_right _ (Finset.mem_filter.mpr ⟨hxS, hW⟩) · exact Finset.mem_union_left _ (trace_union_subset_minimal S hcp (covered_point_mem_trace_union hcp hxI (hasAPCover_triple_of_not_witness hcp hc hp hxS hW))) theorem trace_card_le_minimal_union_add_neighbors {S : Finset ℕ} {c p : ℕ} (hcp : c < p) (hc : c ∈ S) (hp : p ∈ S) : (S ∩ Finset.Icc c p).card ≤ ((minimalTraceSteps S c p).biUnion (apSegment c p)).card + (witnessNeighbors S c p).card := (Finset.card_le_card (trace_cover_by_minimal_and_neighbors hcp hc hp)).trans (Finset.card_union_le _ _) end /- Right-hand prefix extensions of every divisor-minimal trace. -/ section open Finset theorem minimal_trace_prefix_family {S : Finset ℕ} {c p : ℕ} (hcp : c < p) : ∃ k : ℕ → ℕ, ∀ d ∈ minimalTraceSteps S c p, 1 ≤ k d ∧ natAP c d (k d + 1) ⊆ S ∧ apSegment c p d ⊆ natAP c d (k d + 1) ∧ ∀ z ∈ S, p ≤ z → z ∉ natAP c d (k d + 1) → ∀ i : ℕ, 0 < i → i ≤ k d → i.Coprime (anchorDistance c z) → IsWitnessPair S c {c + i*d, z} := by classical have hex : ∀ d : ℕ, ∃ k : ℕ, d ∈ minimalTraceSteps S c p → 1 ≤ k ∧ natAP c d (k + 1) ⊆ S ∧ apSegment c p d ⊆ natAP c d (k + 1) ∧ ∀ z ∈ S, p ≤ z → z ∉ natAP c d (k + 1) → ∀ i : ℕ, 0 < i → i ≤ k → i.Coprime (anchorDistance c z) → IsWitnessPair S c {c + i*d, z} := by intro d by_cases hdJ : d ∈ minimalTraceSteps S c p · obtain ⟨hdT, hmin⟩ := Finset.mem_filter.mp hdJ obtain ⟨hdD, hdS⟩ := Finset.mem_filter.mp hdT have hd : 0 < d := Nat.pos_of_mem_divisors hdD obtain ⟨U, hUS, hAP, hcon, hTU, hW⟩ := minimal_trace_witness_core_consecutive hcp hd (Nat.mem_divisors.mp hdD).1 hdS hmin obtain ⟨k, hk, hright⟩ := ap_right_prefix_of_consecutive hd hAP hcon refine ⟨k, fun _ => ⟨hk, ?_, ?_, ?_⟩⟩ · rw [← hright] exact (Finset.filter_subset _ _).trans hUS · intro x hx rw [← hright] exact Finset.mem_filter.mpr ⟨hTU hx, (Finset.mem_Icc.mp (Finset.mem_filter.mp hx).1).1⟩ · intro z hz hpz hzP i hi hik hcop have hzU : z ∉ U := by intro hzU apply hzP rw [← hright] exact Finset.mem_filter.mpr ⟨hzU, by omega⟩ apply hW z hz hpz hzU i hi · have hy : c + i*d ∈ natAP c d (k+1) := mem_natAP.mpr ⟨i, by omega, rfl⟩ rw [← hright] at hy exact (Finset.mem_filter.mp hy).1 · exact hcop · exact ⟨0, fun hh => False.elim (hdJ hh)⟩ choose k hk using hex exact ⟨k, hk⟩ theorem exists_biUnion_card_between {α β : Type*} [DecidableEq β] (J : Finset α) (R : α → Finset β) {K : ℕ} (hK : 0 < K) (hsmall : ∀ d ∈ J, (R d).card ≤ K) (hlarge : K ≤ (J.biUnion R).card) : ∃ I : Finset α, I ⊆ J ∧ K ≤ (I.biUnion R).card ∧ (I.biUnion R).card ≤ 2*K := by classical revert hsmall hlarge induction J using Finset.induction_on with | empty => intro hsmall hlarge simp only [Finset.biUnion_empty, Finset.card_empty] at hlarge omega | @insert a J ha ih => intro hsmall hlarge by_cases hJ : K ≤ (J.biUnion R).card · obtain ⟨I, hIJ, hlo, hhi⟩ := ih (fun d hd => hsmall d (Finset.mem_insert_of_mem hd)) hJ exact ⟨I, hIJ.trans (Finset.subset_insert _ _), hlo, hhi⟩ · refine ⟨insert a J, Finset.Subset.refl _, hlarge, ?_⟩ rw [Finset.biUnion_insert] have hh := Finset.card_union_le (R a) (J.biUnion R) have haK := hsmall a (Finset.mem_insert_self _ _) omega end /- Simultaneous witness counting across distinct divisor-minimal trace steps. -/ section open Finset theorem coprimePrefix_log_lower {m : ℕ} (hm : 0 < m) (K : ℕ) : K ≤ (coprimePrefix m K + 2 * m.divisors.card) * (Nat.log 2 m + 1) := by have hI : Finset.Ioc 0 K = Finset.Icc 1 K := by ext i simp only [Finset.mem_Ioc, Finset.mem_Icc] omega have hh := coprimeInterval_log_lower hm (Nat.zero_le K) simpa only [Nat.sub_zero, hI, coprimePrefix] using hh theorem trace_witness_codes_card_le {S H J Z : Finset ℕ} {c p : ℕ} (k : ℕ → ℕ) (hJ : J ⊆ (p - c).divisors) (hprefix : ∀ d ∈ J, natAP c d (k d + 1) ⊆ H) (houtside : Disjoint Z H) (hW : ∀ z ∈ Z, ∀ d ∈ J, ∀ i : ℕ, 0 < i → i ≤ k d → i.Coprime (anchorDistance c z) → IsWitnessPair S c {c + i * d, z}) : (∑ z ∈ Z, ∑ d ∈ J, coprimePrefix ((p - c) * anchorDistance c z) (k d)) ≤ (structuralWitnessPairs S c).card := by classical let V : Finset (Σ _ : ℕ, Σ _ : ℕ, ℕ) := Z.sigma (fun z => J.sigma (fun d => (Finset.Icc 1 (k d)).filter (fun i => ((p - c) * anchorDistance c z).Coprime i))) let f : (Σ _ : ℕ, Σ _ : ℕ, ℕ) → Finset ℕ := fun q => {c + q.2.2 * q.2.1, q.1} have hspec : ∀ q ∈ V, q.1 ∈ Z ∧ q.2.1 ∈ J ∧ c + q.2.2 * q.2.1 ∈ H ∧ q.2.2.Coprime (p - c) ∧ IsWitnessPair S c (f q) := by intro q hq obtain ⟨hz, hd, hi⟩ := Finset.mem_sigma.mp hq |>.imp_right Finset.mem_sigma.mp obtain ⟨hiI, hcop⟩ := Finset.mem_filter.mp hi obtain ⟨hi1, hik⟩ := Finset.mem_Icc.mp hiI have hcops := Nat.coprime_mul_iff_left.mp hcop refine ⟨hz, hd, hprefix q.2.1 hd (mem_natAP.mpr ⟨q.2.2, by omega, rfl⟩), hcops.1.symm, ?_⟩ exact hW q.1 hz q.2.1 hd q.2.2 hi1 hik hcops.2.symm have hmaps : Set.MapsTo f (V : Set (Σ _ : ℕ, Σ _ : ℕ, ℕ)) (structuralWitnessPairs S c : Set (Finset ℕ)) := fun q hq => mem_structuralWitnessPairs.mpr (hspec q hq).2.2.2.2 have hinj : Set.InjOn f (V : Set (Σ _ : ℕ, Σ _ : ℕ, ℕ)) := by rintro ⟨z, d, i⟩ hz ⟨w, e, j⟩ hw heq change ({c + i*d, z} : Finset ℕ) = {c + j*e, w} at heq have hzS := hspec ⟨z, d, i⟩ hz have hwS := hspec ⟨w, e, j⟩ hw have hzNot : z ∉ H := fun hzH => Finset.disjoint_left.mp houtside hzS.1 hzH have hwNot : w ∉ H := fun hwH => Finset.disjoint_left.mp houtside hwS.1 hwH have hzmem : z ∈ ({c + j*e, w} : Finset ℕ) := by rw [← heq]; simp have hzw : z = w := by simp only [Finset.mem_insert, Finset.mem_singleton] at hzmem rcases hzmem with hh | hh · exact False.elim (hzNot (hh.symm ▸ hwS.2.2.1)) · exact hh have hymem : c + i*d ∈ ({c + j*e, w} : Finset ℕ) := by rw [← heq]; simp have hy : c + i*d = c + j*e := by simp only [Finset.mem_insert, Finset.mem_singleton] at hymem rcases hymem with hh | hh · exact hh · exact False.elim (hwNot (hh ▸ hzS.2.2.1)) have hde : d = e := coprime_index_recovers_divisor (Nat.mem_divisors.mp (hJ hzS.2.1)).1 (Nat.mem_divisors.mp (hJ hwS.2.1)).1 hzS.2.2.2.1 hwS.2.2.2.1 (by change i*d = j*e; exact Nat.add_left_cancel hy) have hdpos : 0 < d := Nat.pos_of_mem_divisors (hJ hzS.2.1) have hij : i = j := by rw [← hde] at hy; nlinarith only [hy, hdpos] cases hzw cases hde cases hij rfl simpa [V, Finset.card_sigma, coprimePrefix] using Finset.card_le_card_of_injOn f hmaps hinj theorem trace_row_coprime_count {N D c p z : ℕ} {J : Finset ℕ} (k : ℕ → ℕ) (hc : c ∈ Finset.Icc 1 N) (hp : p ∈ Finset.Icc 1 N) (hcp : c < p) (hz : z ∈ Finset.Icc 1 N) (hpz : p ≤ z) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) : (∑ d ∈ J, k d) ≤ 2 * (Nat.log 2 N + 1) * ((∑ d ∈ J, coprimePrefix ((p - c) * anchorDistance c z) (k d)) + 2 * J.card * D) := by let m := (p - c) * anchorDistance c z have hdist : 0 < anchorDistance c z := anchorDistance_pos (by omega) have hm : 0 < m := Nat.mul_pos (by omega) hdist have hpN : p - c ≤ N := by have := Finset.mem_Icc.mp hp; omega have hmN : m ≤ N^2 := by simpa only [m, pow_two] using Nat.mul_le_mul hpN (anchorDistance_le_of_mem hc hz) have htau := hdivisor m hmN have hlog := natLog_succ_le_twice_of_le_square hmN have hrow : ∀ d ∈ J, k d ≤ 2 * (Nat.log 2 N + 1) * (coprimePrefix m (k d) + 2 * D) := by intro d hd have hfirst := coprimePrefix_log_lower hm (k d) have hcoef := Nat.add_le_add_left (Nat.mul_le_mul_left 2 htau) (coprimePrefix m (k d)) exact hfirst.trans (by simpa only [Nat.mul_comm] using Nat.mul_le_mul hcoef hlog) have hsum := Finset.sum_le_sum hrow rw [← Finset.mul_sum, Finset.sum_add_distrib] at hsum simp only [Finset.sum_const, smul_eq_mul] at hsum simpa only [m, Nat.mul_assoc, Nat.mul_left_comm J.card 2] using hsum theorem many_witnesses_from_traces {N D c p : ℕ} {S H J Z : Finset ℕ} (k : ℕ → ℕ) (hc : c ∈ Finset.Icc 1 N) (hp : p ∈ Finset.Icc 1 N) (hcp : c < p) (hZ : Z ⊆ Finset.Icc 1 N) (htail : ∀ z ∈ Z, p ≤ z) (hJ : J ⊆ (p - c).divisors) (hprefix : ∀ d ∈ J, natAP c d (k d + 1) ⊆ H) (houtside : Disjoint Z H) (hW : ∀ z ∈ Z, ∀ d ∈ J, ∀ i : ℕ, 0 < i → i ≤ k d → i.Coprime (anchorDistance c z) → IsWitnessPair S c {c + i * d, z}) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 8 * (Nat.log 2 N + 1) * J.card * D ≤ ∑ d ∈ J, k d) : Z.card * (∑ d ∈ J, k d) ≤ 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card := by have hrow : ∀ z ∈ Z, (∑ d ∈ J, k d) ≤ 4 * (Nat.log 2 N + 1) * ∑ d ∈ J, coprimePrefix ((p - c) * anchorDistance c z) (k d) := by intro z hz have hh := trace_row_coprime_count (J := J) k hc hp hcp (hZ hz) (htail z hz) hdivisor nlinarith only [hh, hsize] have hsum := Finset.sum_le_sum hrow have hcount := trace_witness_codes_card_le k hJ hprefix houtside hW have hmul := Nat.mul_le_mul_left (4 * (Nat.log 2 N + 1)) hcount simp only [Finset.sum_const, smul_eq_mul, ← Finset.mul_sum] at hsum omega end /- ShortTrace -/ /- The short-prefix case supplies quadratically many structural witnesses. -/ section open Finset theorem short_prefix_many_witnesses {N D c p K : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hc : c ∈ S) (hp : p ∈ S) (hcp : c < p) (hK : 0 < K) (hhead : 2*K ≤ (S ∩ Finset.Icc c p).card) (htail : 4*K ≤ (S.filter (fun z => p ≤ z)).card) (hneighbors : (witnessNeighbors S c p).card ≤ K) (hno : ∀ d : ℕ, 0 < d → ¬ natAP c d (K + 1) ⊆ S) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16 * (Nat.log 2 N + 1) * D^2 + D ≤ K) : K^2 ≤ 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card := by classical obtain ⟨k, hk⟩ := minimal_trace_prefix_family (S := S) hcp let J := minimalTraceSteps S c p let R : ℕ → Finset ℕ := fun d => natAP c d (k d + 1) have hJD : J ⊆ (p - c).divisors := (Finset.filter_subset _ _).trans (Finset.filter_subset _ _) have hsmall : ∀ d ∈ J, (R d).card ≤ K := by intro d hdJ have hd := Nat.pos_of_mem_divisors (hJD hdJ) have hdK : k d < K := by by_contra hn apply hno d hd intro x hx obtain ⟨i, hi, hxi⟩ := mem_natAP.mp hx exact (hk d hdJ).2.1 (mem_natAP.mpr ⟨i, by omega, hxi⟩) simpa only [R, card_natAP hd] using (by omega : k d + 1 ≤ K) have htraceSub : J.biUnion (apSegment c p) ⊆ J.biUnion R := by intro x hx obtain ⟨d, hd, hxd⟩ := Finset.mem_biUnion.mp hx exact Finset.mem_biUnion.mpr ⟨d, hd, (hk d hd).2.2.1 hxd⟩ have hlarge : K ≤ (J.biUnion R).card := by have hh := trace_card_le_minimal_union_add_neighbors hcp hc hp have htr := Finset.card_le_card htraceSub change (J.biUnion (apSegment c p)).card ≤ _ at htr change (S ∩ Finset.Icc c p).card ≤ (J.biUnion (apSegment c p)).card + _ at hh omega obtain ⟨I, hIJ, hIlow, hIhigh⟩ := exists_biUnion_card_between J R hK hsmall hlarge let H := I.biUnion R let Z := (S.filter (fun z => p ≤ z)) \ H have hID : I ⊆ (p - c).divisors := hIJ.trans hJD have hpN : p - c ≤ N := by have := Finset.mem_Icc.mp (hS hp); omega have hNN : N ≤ N^2 := by nlinarith only [Nat.zero_le N] have hD : I.card ≤ D := (Finset.card_le_card hID).trans (hdivisor (p - c) (hpN.trans hNN)) have hsum : H.card ≤ (∑ d ∈ I, k d) + I.card := by have hh := Finset.card_biUnion_le (s := I) (t := R) have hcards : (∑ d ∈ I, (R d).card) = (∑ d ∈ I, k d) + I.card := by calc (∑ d ∈ I, (R d).card) = ∑ d ∈ I, (k d + 1) := Finset.sum_congr rfl (fun d hd => card_natAP (Nat.pos_of_mem_divisors (hID hd))) _ = _ := by simp only [Finset.sum_add_distrib, Finset.sum_const, smul_eq_mul, mul_one] exact hh.trans_eq hcards have hlog : 1 ≤ Nat.log 2 N + 1 := by omega have hDD : D ≤ D^2 := by nlinarith only [Nat.zero_le D] have htwice : 2*D ≤ K := by have hh := Nat.mul_le_mul_right (D^2) hlog nlinarith only [hsize, hDD, hh] have hsumK : K ≤ 2 * (∑ d ∈ I, k d) := by change K ≤ H.card at hIlow omega have hsumSize : 8 * (Nat.log 2 N + 1) * I.card * D ≤ ∑ d ∈ I, k d := by have hh := Nat.mul_le_mul_right (8 * (Nat.log 2 N + 1) * D) hD change K ≤ H.card at hIlow nlinarith only [hsize, hsum, hIlow, hD, hh] have hZcard : 2*K ≤ Z.card := by have hh := Finset.card_le_card_sdiff_add_card (s := S.filter (fun z => p ≤ z)) (t := H) change (S.filter (fun z => p ≤ z)).card ≤ Z.card + H.card at hh change H.card ≤ 2*K at hIhigh omega have hcount := many_witnesses_from_traces (S := S) (H := H) (J := I) (Z := Z) k (hS hc) (hS hp) hcp (fun z hz => hS (Finset.mem_filter.mp (Finset.mem_sdiff.mp hz).1).1) (fun z hz => (Finset.mem_filter.mp (Finset.mem_sdiff.mp hz).1).2) hID (fun d hd x hx => Finset.mem_biUnion.mpr ⟨d, hd, hx⟩) (Finset.disjoint_left.mpr (fun z hz hzH => (Finset.mem_sdiff.mp hz).2 hzH)) (by intro z hz d hd i hi hik hcop have hzS := (Finset.mem_filter.mp (Finset.mem_sdiff.mp hz).1).1 have hpz := (Finset.mem_filter.mp (Finset.mem_sdiff.mp hz).1).2 have hzR : z ∉ R d := fun hzr => (Finset.mem_sdiff.mp hz).2 (Finset.mem_biUnion.mpr ⟨d, hd, hzr⟩) exact (hk d (hIJ hd)).2.2.2 z hzS hpz hzR i hi hik hcop) hdivisor hsumSize have hprod1 := Nat.mul_le_mul_right (∑ d ∈ I, k d) hZcard have hprod2 := Nat.mul_le_mul_left K hsumK nlinarith only [hcount, hprod1, hprod2] end /- WitnessSelection -/ /- Middle-point selection and incidence bounds for private witness pairs. -/ section open Finset theorem exists_middle_block {T : Finset ℕ} {K : ℕ} (hcard : 8*K ≤ T.card) : ∃ M : Finset ℕ, M ⊆ T ∧ M.card = K ∧ ∀ p ∈ M, 2*K ≤ (T.filter (fun x => x ≤ p)).card ∧ 4*K ≤ (T.filter (fun x => p ≤ x)).card := by classical let f := T.orderEmbOfFin rfl let mid : Fin K → ℕ := fun i => f ⟨2*K + i.val, by omega⟩ have hinj : Function.Injective mid := by intro i j hij have hh := f.injective hij have hv := congrArg Fin.val hh apply Fin.ext change 2*K + i.val = 2*K + j.val at hv omega refine ⟨Finset.univ.image mid, ?_, ?_, ?_⟩ · intro p hp obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp hp exact T.orderEmbOfFin_mem rfl _ · rw [Finset.card_image_of_injective _ hinj, Finset.card_univ, Fintype.card_fin] · intro p hp obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp hp constructor · let lo : Fin (2*K) → ℕ := fun j => f ⟨j.val, by omega⟩ have hlo : Function.Injective lo := by intro a b hab have hh := congrArg Fin.val (f.injective hab) exact Fin.ext hh have hmaps : Set.MapsTo lo (↑(Finset.univ : Finset (Fin (2*K))) : Set (Fin (2*K))) (T.filter (fun x => x ≤ mid i) : Set ℕ) := by intro j hj refine Finset.mem_filter.mpr ⟨T.orderEmbOfFin_mem rfl _, ?_⟩ apply f.monotone change j.val ≤ 2*K + i.val omega simpa only [Finset.card_univ, Fintype.card_fin] using Finset.card_le_card_of_injOn lo hmaps hlo.injOn · let hi : Fin (4*K) → ℕ := fun j => f ⟨4*K + j.val, by omega⟩ have hhi : Function.Injective hi := by intro a b hab have hh := congrArg Fin.val (f.injective hab) apply Fin.ext change 4*K + a.val = 4*K + b.val at hh omega have hmaps : Set.MapsTo hi (↑(Finset.univ : Finset (Fin (4*K))) : Set (Fin (4*K))) (T.filter (fun x => mid i ≤ x) : Set ℕ) := by intro j hj refine Finset.mem_filter.mpr ⟨T.orderEmbOfFin_mem rfl _, ?_⟩ apply f.monotone change 2*K + i.val ≤ 4*K + j.val omega simpa only [Finset.card_univ, Fintype.card_fin] using Finset.card_le_card_of_injOn hi hmaps hhi.injOn theorem sum_witnessNeighbors_card_le (S M : Finset ℕ) (c : ℕ) : (∑ p ∈ M, (witnessNeighbors S c p).card) ≤ 2 * (structuralWitnessPairs S c).card := by classical let A := M.sigma (witnessNeighbors S c) let B := (structuralWitnessPairs S c).sigma (fun Q => Q) let f : (Σ _ : ℕ, ℕ) → (Σ _ : Finset ℕ, ℕ) := fun q => ⟨{q.1, q.2}, q.1⟩ have hspec : ∀ q ∈ A, IsWitnessPair S c {q.1, q.2} := by intro q hq exact (Finset.mem_filter.mp (Finset.mem_sigma.mp hq).2).2 have hmaps : Set.MapsTo f (A : Set (Σ _ : ℕ, ℕ)) (B : Set (Σ _ : Finset ℕ, ℕ)) := by intro q hq exact Finset.mem_sigma.mpr ⟨mem_structuralWitnessPairs.mpr (hspec q hq), by simp [f]⟩ have hinj : Set.InjOn f (A : Set (Σ _ : ℕ, ℕ)) := by rintro ⟨p, x⟩ hx ⟨q, y⟩ hy heq have hpq : p = q := congrArg (fun z : (Σ _ : Finset ℕ, ℕ) => z.2) heq subst q have hpair : ({p, x} : Finset ℕ) = {p, y} := congrArg Sigma.fst heq have hpx : p ≠ x := by intro hh have hc := (hspec ⟨p, x⟩ hx).1 simp [hh] at hc have hxmem : x ∈ ({p, y} : Finset ℕ) := by rw [← hpair]; simp have hxy : x = y := by simp only [Finset.mem_insert, Finset.mem_singleton] at hxmem exact hxmem.resolve_left hpx.symm subst y rfl have hB : B.card = 2 * (structuralWitnessPairs S c).card := by rw [Finset.card_sigma] have hh : (∑ Q ∈ structuralWitnessPairs S c, Q.card) = ∑ _Q ∈ structuralWitnessPairs S c, 2 := Finset.sum_congr rfl (fun Q hQ => (mem_structuralWitnessPairs.mp hQ).1) simpa only [Finset.sum_const, smul_eq_mul, Nat.mul_comm] using hh have hbound := (Finset.card_le_card_of_injOn f hmaps hinj).trans_eq hB simpa only [A, Finset.card_sigma] using hbound end /- LongPrefix -/ /- Preserve the anchored prefix in the long-prefix witness estimate. -/ section open Finset theorem minimal_prefix_many_witnesses_anchored {N D c d K : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hd : 0 < d) (hK : 1 ≤ K) (hprefix : natAP c d (K + 1) ⊆ S) (hmin : ∀ e : ℕ, 0 < e → natAP c e (K + 1) ⊆ S → d ≤ e) (hdivisor : ∀ n ≤ N, n.divisors.card ≤ D) (hlength : 8 * D * (Nat.log 2 N + 1) ≤ K) : ∃ U : Finset ℕ, U ⊆ S ∧ (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) ∧ natAP c d (K + 1) ⊆ U ∧ (S \ U).card * K ≤ 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card := by obtain ⟨U, hUS, hUAP, hPU, hW⟩ := minimal_prefix_witness_core hd hK hprefix hmin refine ⟨U, hUS, hUAP, hPU, ?_⟩ have hcP : c ∈ natAP c d (K + 1) := mem_natAP.mpr ⟨0, by omega, by simp⟩ have hcI : c ∈ Finset.Icc 1 N := hS (hprefix hcP) have hrow : ∀ z ∈ S \ U, K ≤ 4 * (Nat.log 2 N + 1) * ((Finset.Ioc (K / 2) K).filter (fun p => (anchorDistance c z).Coprime p)).card := by intro z hz obtain ⟨hzS, hzU⟩ := Finset.mem_sdiff.mp hz have hcz : c ≠ z := fun heq => hzU (heq ▸ hPU hcP) have hm : 0 < anchorDistance c z := anchorDistance_pos hcz have hmN : anchorDistance c z ≤ N := anchorDistance_le_of_mem hcI (hS hzS) have htau := hdivisor (anchorDistance c z) hmN have hlog : Nat.log 2 (anchorDistance c z) + 1 ≤ Nat.log 2 N + 1 := Nat.add_le_add_right (Nat.log_mono_right hmN) 1 have hcoef := Nat.mul_le_mul htau hlog have hlen : 4 * (anchorDistance c z).divisors.card * (Nat.log 2 (anchorDistance c z) + 1) ≤ K - K / 2 := by have hhalf : K ≤ 2 * (K - K / 2) := by omega nlinarith only [hcoef, hlength, hhalf] have hcount := coprimeInterval_log_density hm (Nat.div_le_self K 2) hlen have hcount' := hcount.trans (Nat.mul_le_mul_left (2 * ((Finset.Ioc (K / 2) K).filter (fun p => (anchorDistance c z).Coprime p)).card) hlog) have hhalf : K ≤ 2 * (K - K / 2) := by omega nlinarith only [hcount', hhalf] have hsum := Finset.sum_le_sum hrow have hcount := minimal_prefix_witnesses_count hd hPU hW have hbound := Nat.mul_le_mul_left (4 * (Nat.log 2 N + 1)) hcount simp only [Finset.sum_const, smul_eq_mul, ← Finset.mul_sum] at hsum omega end /- RightCoreAlternative -/ /- A right-hand witness/core alternative for a single finite set. -/ section open Finset theorem no_long_right_prefix_many_witnesses {N D c K : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hc : c ∈ S) (hK : 0 < K) (hright : 8*K ≤ (S.filter (fun x => c < x)).card) (hno : ∀ d : ℕ, 0 < d → ¬ natAP c d (K + 1) ⊆ S) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16 * (Nat.log 2 N + 1) * D^2 + D ≤ K) : K^2 ≤ 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card := by classical let T := S.filter (fun x => c < x) obtain ⟨M, hMT, hMcard, hmiddle⟩ := exists_middle_block hright by_cases hsome : ∃ p ∈ M, (witnessNeighbors S c p).card ≤ K · obtain ⟨p, hpM, hneigh⟩ := hsome have hpT := hMT hpM obtain ⟨hpS, hcp⟩ := Finset.mem_filter.mp hpT have hhead : 2*K ≤ (S ∩ Finset.Icc c p).card := (hmiddle p hpM).1.trans (Finset.card_le_card (by intro x hx obtain ⟨hxT, hxp⟩ := Finset.mem_filter.mp hx obtain ⟨hxS, hcx⟩ := Finset.mem_filter.mp hxT exact Finset.mem_inter.mpr ⟨hxS, Finset.mem_Icc.mpr ⟨hcx.le, hxp⟩⟩)) have htail : 4*K ≤ (S.filter (fun x => p ≤ x)).card := (hmiddle p hpM).2.trans (Finset.card_le_card (by intro x hx obtain ⟨hxT, hpx⟩ := Finset.mem_filter.mp hx exact Finset.mem_filter.mpr ⟨(Finset.mem_filter.mp hxT).1, hpx⟩)) exact short_prefix_many_witnesses hS hc hpS hcp hK hhead htail hneigh hno hdivisor hsize · have hneigh : ∀ p ∈ M, K ≤ (witnessNeighbors S c p).card := by intro p hp have hh : ¬ (witnessNeighbors S c p).card ≤ K := fun hn => hsome ⟨p, hp, hn⟩ omega have hlow := Finset.sum_le_sum hneigh simp only [Finset.sum_const, smul_eq_mul, hMcard] at hlow have hupp := sum_witnessNeighbors_card_le S M c have hlog : 1 ≤ Nat.log 2 N + 1 := by omega have hm := Nat.mul_le_mul_right (4 * (structuralWitnessPairs S c).card) hlog nlinarith only [hlow, hupp, hm] theorem right_witness_or_AP_core {N D c K : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hc : c ∈ S) (hK : 0 < K) (hright : 8*K ≤ (S.filter (fun x => c < x)).card) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16 * (Nat.log 2 N + 1) * D^2 + D ≤ K) : K^2 ≤ 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card ∨ ∃ U : Finset ℕ, U ⊆ S ∧ (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) ∧ c ∈ U ∧ (S \ U).card * K ≤ 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card := by classical by_cases hex : ∃ d : ℕ, 0 < d ∧ natAP c d (K + 1) ⊆ S · let d := Nat.find hex have hd := (Nat.find_spec hex).1 have hprefix := (Nat.find_spec hex).2 have hmin : ∀ e : ℕ, 0 < e → natAP c e (K + 1) ⊆ S → d ≤ e := fun e he hpre => Nat.find_min' hex ⟨he, hpre⟩ have hdivN : ∀ n ≤ N, n.divisors.card ≤ D := by intro n hn exact hdivisor n (hn.trans (by nlinarith only [Nat.zero_le N])) have hlength : 8 * D * (Nat.log 2 N + 1) ≤ K := by have hDD : D ≤ D^2 := by nlinarith only [Nat.zero_le D] have hm := Nat.mul_le_mul_left (16 * (Nat.log 2 N + 1)) hDD nlinarith only [hsize, hm, Nat.zero_le (D * (Nat.log 2 N + 1))] obtain ⟨U, hUS, hAP, hPU, hbound⟩ := minimal_prefix_many_witnesses_anchored hS hd hK hprefix hmin hdivN hlength exact Or.inr ⟨U, hUS, hAP, hPU (mem_natAP.mpr ⟨0, by omega, by simp⟩), hbound⟩ · apply Or.inl apply no_long_right_prefix_many_witnesses hS hc hK hright _ hdivisor hsize exact fun d hd hpre => hex ⟨d, hd, hpre⟩ end /- Reflection -/ /- Reflection of bounded sets, arithmetic progressions, and intrinsic witnesses. -/ section open Finset def reflectPoint (N x : ℕ) : ℕ := N + 1 - x def reflectSet (N : ℕ) (S : Finset ℕ) : Finset ℕ := S.image (reflectPoint N) theorem reflectPoint_mem {N x : ℕ} (hx : x ∈ Finset.Icc 1 N) : reflectPoint N x ∈ Finset.Icc 1 N := by simp only [reflectPoint, Finset.mem_Icc] at * omega theorem reflectPoint_involutive {N x : ℕ} (hx : x ≤ N+1) : reflectPoint N (reflectPoint N x) = x := by dsimp [reflectPoint] omega theorem reflectPoint_injOn (N : ℕ) : Set.InjOn (reflectPoint N) (Finset.Icc 1 N : Set ℕ) := by intro x hx y hy hxy have hxN := (Finset.mem_Icc.mp hx).2 have hyN := (Finset.mem_Icc.mp hy).2 dsimp [reflectPoint] at hxy omega theorem reflectSet_subset {N : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) : reflectSet N S ⊆ Finset.Icc 1 N := by intro x hx obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx exact reflectPoint_mem (hS hy) theorem reflectSet_mono {N : ℕ} {S T : Finset ℕ} (h : S ⊆ T) : reflectSet N S ⊆ reflectSet N T := Finset.image_subset_image h theorem reflectSet_involutive {N : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) : reflectSet N (reflectSet N S) = S := by dsimp [reflectSet] rw [Finset.image_image] calc S.image (fun x => reflectPoint N (reflectPoint N x)) = S.image id := by apply Finset.image_congr intro x hx exact reflectPoint_involutive (by have := Finset.mem_Icc.mp (hS hx); omega) _ = S := Finset.image_id theorem reflectSet_card {N : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) : (reflectSet N S).card = S.card := by exact Finset.card_image_of_injOn ((reflectPoint_injOn N).mono hS) theorem reflectSet_sdiff {N : ℕ} {S T : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hTS : T ⊆ S) : reflectSet N (S \ T) = reflectSet N S \ reflectSet N T := by exact Finset.image_sdiff_of_injOn ((reflectPoint_injOn N).mono hS) hTS theorem reflectSet_natAP {N a d k : ℕ} (hk : 0 < k) (htop : a + (k-1)*d ≤ N+1) : reflectSet N (natAP a d k) = natAP (N+1 - (a+(k-1)*d)) d k := by ext x constructor · intro hx obtain ⟨y, hy, hyx⟩ := Finset.mem_image.mp hx obtain ⟨i, hi, rfl⟩ := mem_natAP.mp hy refine mem_natAP.mpr ⟨k-1-i, by omega, ?_⟩ have heq : i*d + (k-1-i)*d = (k-1)*d := by rw [← Nat.add_mul] congr 1 omega have hsub : a+(k-1)*d + (N+1 - (a+(k-1)*d)) = N+1 := Nat.add_sub_of_le htop dsimp [reflectPoint] at hyx omega · intro hx obtain ⟨j, hj, rfl⟩ := mem_natAP.mp hx refine Finset.mem_image.mpr ⟨a + (k-1-j)*d, mem_natAP.mpr ⟨k-1-j, by omega, rfl⟩, ?_⟩ have heq : j*d + (k-1-j)*d = (k-1)*d := by rw [← Nat.add_mul] congr 1 omega have hsub : a+(k-1)*d + (N+1 - (a+(k-1)*d)) = N+1 := Nat.add_sub_of_le htop dsimp [reflectPoint] omega theorem reflectSet_isAP {N : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hAP : ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) : ∃ l : ℕ∞, (reflectSet N S : Set ℕ).IsAPOfLength l := by rcases S.eq_empty_or_nonempty with hzero | hne · simpa [hzero, reflectSet] using hAP by_cases hsmall : S.card ≤ 2 · obtain ⟨l, hl, hAP'⟩ := nonempty_small_isAP (hne.image (reflectPoint N)) (by change (reflectSet N S).card ≤ 2; rw [reflectSet_card hS]; exact hsmall) exact ⟨l, hAP'⟩ · obtain ⟨l, hl⟩ := hAP obtain ⟨a, d, hd, hrep⟩ := nat_ap_eq_natAP hl (by omega) have hk : 0 < S.card := Finset.card_pos.mpr hne have hlast : a + (S.card-1)*d ∈ S := by have hh : a + (S.card-1)*d ∈ natAP a d S.card := mem_natAP.mpr ⟨S.card-1, by omega, rfl⟩ rwa [← hrep] at hh have htop : a + (S.card-1)*d ≤ N+1 := by have := Finset.mem_Icc.mp (hS hlast) omega rw [hrep, reflectSet_natAP hk htop] exact ⟨_, natAP_isAP hd⟩ theorem reflectSet_AP_cover {N : ℕ} {S T : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hcover : HasAPCover S T) : HasAPCover (reflectSet N S) (reflectSet N T) := by obtain ⟨U, hUS, hAP, hTU⟩ := hcover exact ⟨reflectSet N U, reflectSet_mono hUS, reflectSet_isAP (hUS.trans hS) hAP, reflectSet_mono hTU⟩ theorem reflectSet_witness_pair {N c : ℕ} {S Q : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hc : c ∈ S) (hW : IsWitnessPair S c Q) : IsWitnessPair (reflectSet N S) (reflectPoint N c) (reflectSet N Q) := by have hQS : Q ⊆ S := hW.2.1.trans (Finset.erase_subset _ _) have hQ := hQS.trans hS refine ⟨(reflectSet_card hQ).trans hW.1, ?_, ?_⟩ · intro x hx obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx refine Finset.mem_erase.mpr ⟨?_, Finset.mem_image.mpr ⟨y, hQS hy, rfl⟩⟩ intro heq exact (Finset.mem_erase.mp (hW.2.1 hy)).1 (reflectPoint_injOn N (hQ hy) (hS hc) heq) · intro hcover have hh := reflectSet_AP_cover (reflectSet_subset hS) hcover have heq : reflectSet N (insert (reflectPoint N c) (reflectSet N Q)) = insert c Q := by change (insert (reflectPoint N c) (reflectSet N Q)).image (reflectPoint N) = _ rw [Finset.image_insert, reflectPoint_involutive (by have := Finset.mem_Icc.mp (hS hc); omega)] exact congrArg (insert c) (reflectSet_involutive hQ) rw [reflectSet_involutive hS, heq] at hh exact hW.2.2 hh theorem reflectSet_witness_count {N c : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hc : c ∈ S) : (structuralWitnessPairs (reflectSet N S) (reflectPoint N c)).card = (structuralWitnessPairs S c).card := by classical have hle : ∀ {T : Finset ℕ} {b : ℕ}, T ⊆ Finset.Icc 1 N → b ∈ T → (structuralWitnessPairs T b).card ≤ (structuralWitnessPairs (reflectSet N T) (reflectPoint N b)).card := by intro T b hT hb apply Finset.card_le_card_of_injOn (reflectSet N) · intro Q hQ exact mem_structuralWitnessPairs.mpr (reflectSet_witness_pair hT hb (mem_structuralWitnessPairs.mp hQ)) · intro Q hQ R hR heq have hQT : Q ⊆ Finset.Icc 1 N := (mem_structuralWitnessPairs.mp hQ).2.1.trans ((Finset.erase_subset _ _).trans hT) have hRT : R ⊆ Finset.Icc 1 N := (mem_structuralWitnessPairs.mp hR).2.1.trans ((Finset.erase_subset _ _).trans hT) have hh := congrArg (reflectSet N) heq simpa only [reflectSet_involutive hQT, reflectSet_involutive hRT] using hh have hlo := hle hS hc have hhi := hle (reflectSet_subset hS) (Finset.mem_image.mpr ⟨c, hc, rfl⟩) rw [reflectSet_involutive hS, reflectPoint_involutive (by have := Finset.mem_Icc.mp (hS hc); omega)] at hhi exact Nat.le_antisymm hhi hlo theorem reflectSet_filter_lt {N c : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hc : c ∈ S) : reflectSet N (S.filter (fun x => x < c)) = (reflectSet N S).filter (fun y => reflectPoint N c < y) := by have hcN := Finset.mem_Icc.mp (hS hc) ext y constructor · intro hy obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hy obtain ⟨hxS, hxc⟩ := Finset.mem_filter.mp hx have hxN := Finset.mem_Icc.mp (hS hxS) refine Finset.mem_filter.mpr ⟨Finset.mem_image.mpr ⟨x, hxS, rfl⟩, ?_⟩ dsimp [reflectPoint] omega · intro hy obtain ⟨hyS, hcy⟩ := Finset.mem_filter.mp hy obtain ⟨x, hxS, rfl⟩ := Finset.mem_image.mp hyS have hxN := Finset.mem_Icc.mp (hS hxS) refine Finset.mem_image.mpr ⟨x, Finset.mem_filter.mpr ⟨hxS, ?_⟩, rfl⟩ dsimp [reflectPoint] at hcy omega end /- WitnessCoreAlternative -/ /- The witness/core alternative at an arbitrary anchor, in either orientation. -/ section open Finset theorem card_sides_add_one {S : Finset ℕ} {c : ℕ} (hc : c ∈ S) : (S.filter (fun x => x < c)).card + (S.filter (fun x => c < x)).card + 1 = S.card := by have hunion : S.filter (fun x => x < c) ∪ S.filter (fun x => c < x) = S.erase c := by ext x simp only [Finset.mem_union, Finset.mem_filter, Finset.mem_erase] constructor · rintro (⟨hx, hxc⟩ | ⟨hx, hcx⟩) · exact ⟨hxc.ne, hx⟩ · exact ⟨hcx.ne', hx⟩ · rintro ⟨hne, hx⟩ rcases lt_or_gt_of_ne hne with hh | hh · exact Or.inl ⟨hx, hh⟩ · exact Or.inr ⟨hx, hh⟩ have hdisj : Disjoint (S.filter (fun x => x < c)) (S.filter (fun x => c < x)) := by apply Finset.disjoint_left.mpr intro x hx hy have := (Finset.mem_filter.mp hx).2 have := (Finset.mem_filter.mp hy).2 omega have hh := Finset.card_union_of_disjoint hdisj rw [hunion, Finset.card_erase_of_mem hc] at hh have hpos := Finset.card_pos.mpr (show S.Nonempty from ⟨c, hc⟩) omega theorem witness_or_AP_core {N D c K : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hc : c ∈ S) (hK : 0 < K) (hcard : 16*K + 1 ≤ S.card) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16 * (Nat.log 2 N + 1) * D^2 + D ≤ K) : K^2 ≤ 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card ∨ ∃ U : Finset ℕ, U ⊆ S ∧ (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) ∧ c ∈ U ∧ (S \ U).card * K ≤ 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card := by by_cases hright : 8*K ≤ (S.filter (fun x => c < x)).card · exact right_witness_or_AP_core hS hc hK hright hdivisor hsize have hleft : 8*K ≤ (S.filter (fun x => x < c)).card := by have hh := card_sides_add_one hc omega have hright' : 8*K ≤ ((reflectSet N S).filter (fun y => reflectPoint N c < y)).card := by rw [← reflectSet_filter_lt hS hc, reflectSet_card ((Finset.filter_subset _ _).trans hS)] exact hleft have hc' : reflectPoint N c ∈ reflectSet N S := Finset.mem_image.mpr ⟨c, hc, rfl⟩ rcases right_witness_or_AP_core (reflectSet_subset hS) hc' hK hright' hdivisor hsize with hmany | hcore · exact Or.inl (by simpa only [reflectSet_witness_count hS hc] using hmany) · obtain ⟨V, hVS, hAP, hcV, hcount⟩ := hcore have hV : V ⊆ Finset.Icc 1 N := hVS.trans (reflectSet_subset hS) have hUS : reflectSet N V ⊆ S := by have hh := reflectSet_mono (N := N) hVS rwa [reflectSet_involutive hS] at hh refine Or.inr ⟨reflectSet N V, hUS, reflectSet_isAP hV hAP, ?_, ?_⟩ · exact Finset.mem_image.mpr ⟨reflectPoint N c, hcV, reflectPoint_involutive (by have := Finset.mem_Icc.mp (hS hc); omega)⟩ · have hdiff : (S \ reflectSet N V).card = (reflectSet N S \ V).card := by have hh := reflectSet_card (N := N) (S := reflectSet N S \ V) (Finset.sdiff_subset.trans (reflectSet_subset hS)) rw [reflectSet_sdiff (reflectSet_subset hS) hVS, reflectSet_involutive hS] at hh exact hh simpa only [hdiff, reflectSet_witness_count hS hc] using hcount theorem AP_core_of_few_witnesses {N D c K t : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hc : c ∈ S) (hK : 0 < K) (hcard : 16*K + 1 ≤ S.card) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16 * (Nat.log 2 N + 1) * D^2 + D ≤ K) (ht : t ≤ K) (hfew : 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card < t*K) : ∃ U : Finset ℕ, U ⊆ S ∧ (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) ∧ c ∈ U ∧ (S \ U).card < t := by rcases witness_or_AP_core hS hc hK hcard hdivisor hsize with hmany | hcore · have hh := Nat.mul_le_mul_right K ht nlinarith only [hmany, hfew, hh] · obtain ⟨U, hUS, hAP, hcU, hbound⟩ := hcore refine ⟨U, hUS, hAP, hcU, ?_⟩ exact Nat.lt_of_mul_lt_mul_right (hbound.trans_lt hfew) end /- CoreAsymptotic -/ /- Uniform applicability of the witness/core alternative above the cube-root scale. -/ section open Finset Filter def squareDivisorBound (N : ℕ) : ℕ := (Finset.range (N^2+1)).sup (fun m => m.divisors.card) theorem divisor_card_le_squareDivisorBound {m N : ℕ} (hm : m ≤ N^2) : m.divisors.card ≤ squareDivisorBound N := Finset.le_sup (s := Finset.range (N^2+1)) (f := fun n : ℕ => n.divisors.card) (b := m) (Finset.mem_range.mpr (by omega)) theorem squareDivisorBound_pos {N : ℕ} (hN : 1 ≤ N) : 1 ≤ squareDivisorBound N := by have hh := divisor_card_le_squareDivisorBound (m := 1) (by nlinarith only [hN]) simpa only [Nat.divisors_one, Finset.card_singleton] using hh theorem eventually_squareDivisorBound_pow_le (k : ℕ) : ∀ᶠ N : ℕ in atTop, (squareDivisorBound N)^k ≤ N := by filter_upwards [eventually_uniform_divisor_card_pow_le_square k] with N hN obtain ⟨m, hm, heq⟩ := Finset.exists_mem_eq_sup (Finset.range (N^2+1)) ⟨0, by simp⟩ (fun m => m.divisors.card) change squareDivisorBound N = m.divisors.card at heq rw [heq] exact hN m (by have := Finset.mem_range.mp hm; omega) theorem core_threshold_cubed_le {L D N : ℕ} (hL : 1 ≤ L) (hD : 1 ≤ D) (hLpow : L^12 ≤ N) (hDpow : D^24 ≤ N) (hN : 273^6 ≤ N) : (16 * (16*L*D^2 + D) + 1)^3 ≤ N := by let B := 16 * (16*L*D^2 + D) + 1 have hDD : D ≤ D^2 := by nlinarith only [Nat.zero_le D] have hmul := Nat.mul_le_mul_right (D^2) hL have hmul1 : 1 ≤ L*D^2 := by nlinarith only [hD, hDD, hmul] have hB : B ≤ 273*L*D^2 := by dsimp [B] nlinarith only [hDD, hmul, hmul1] have hpow : B^12 ≤ 273^12 * N^2 := by calc B^12 ≤ (273*L*D^2)^12 := Nat.pow_le_pow_left hB 12 _ = 273^12 * (L^12 * D^24) := by ring _ ≤ 273^12 * (N*N) := Nat.mul_le_mul_left _ (Nat.mul_le_mul hLpow hDpow) _ = _ := by ring have hconst : 273^12 ≤ N^2 := by have hh := Nat.pow_le_pow_left hN 2 simpa only [← pow_mul] using hh have hbound : (B^3)^4 ≤ N^4 := by calc (B^3)^4 = B^12 := by ring _ ≤ 273^12*N^2 := hpow _ ≤ N^2*N^2 := Nat.mul_le_mul_right _ hconst _ = N^4 := by ring exact (Nat.pow_le_pow_iff_left (by decide : 4 ≠ 0)).mp hbound theorem eventually_core_threshold : ∀ᶠ N : ℕ in atTop, (16 * (16 * (Nat.log 2 N + 1) * (squareDivisorBound N)^2 + squareDivisorBound N) + 1)^3 ≤ N := by filter_upwards [eventually_natLog_pow_le 12, eventually_squareDivisorBound_pow_le 24, Filter.eventually_ge_atTop (273^6), Filter.eventually_ge_atTop 1] with N hL hD hN hN1 exact core_threshold_cubed_le (by omega) (squareDivisorBound_pos hN1) hL hD hN theorem eventually_witness_or_AP_core : ∀ᶠ N : ℕ in atTop, ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 N → N ≤ S.card^3 → ∀ c ∈ S, ((S.card-1)/16)^2 ≤ 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card ∨ ∃ U : Finset ℕ, U ⊆ S ∧ (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) ∧ c ∈ U ∧ (S \ U).card * ((S.card-1)/16) ≤ 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card := by filter_upwards [eventually_core_threshold, Filter.eventually_ge_atTop (17^3)] with N hthreshold hN intro S hS hScube c hc have h17 : 17 ≤ S.card := (Nat.pow_le_pow_iff_left (by decide : 3 ≠ 0)).mp (hN.trans hScube) have hcard : 16 * ((S.card-1)/16) + 1 ≤ S.card := by omega have hbound : 16 * (16 * (Nat.log 2 N + 1) * (squareDivisorBound N)^2 + squareDivisorBound N) + 1 ≤ S.card := (Nat.pow_le_pow_iff_left (by decide : 3 ≠ 0)).mp (hthreshold.trans hScube) apply witness_or_AP_core hS hc (by omega) hcard (fun m hm => divisor_card_le_squareDivisorBound hm) omega end /- VariableAnchorCount -/ /- Private witness pairs can be summed over anchors in a fixed transversal. -/ section open Finset theorem sum_variable_anchor_witnesses_le {N : ℕ} {F : Finset (Finset ℕ)} {H : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (anchor : Finset ℕ → ℕ) (hanchor : ∀ S ∈ F, anchor S ∈ S ∧ anchor S ∈ H) : (∑ S ∈ F, (structuralWitnessPairs S (anchor S)).card) ≤ H.card * N.choose 2 := by classical let A := F.sigma (fun S => structuralWitnessPairs S (anchor S)) let B := H ×ˢ (Finset.Icc 1 N).powersetCard 2 let f : (Σ _ : Finset ℕ, Finset ℕ) → ℕ × Finset ℕ := fun q => (anchor q.1, q.2) have hmaps : Set.MapsTo f (A : Set (Σ _ : Finset ℕ, Finset ℕ)) (B : Set (ℕ × Finset ℕ)) := by intro q hq obtain ⟨hS, hQ⟩ := Finset.mem_sigma.mp hq have hW := mem_structuralWitnessPairs.mp hQ refine Finset.mem_product.mpr ⟨(hanchor q.1 hS).2, Finset.mem_powersetCard.mpr ⟨?_, hW.1⟩⟩ exact hW.2.1.trans ((Finset.erase_subset _ _).trans (Finset.mem_powerset.mp (hF.1 hS))) have hinj : Set.InjOn f (A : Set (Σ _ : Finset ℕ, Finset ℕ)) := by rintro ⟨S, Q⟩ hSQ ⟨T, R⟩ hTR heq obtain ⟨hS, hQ⟩ := Finset.mem_sigma.mp hSQ obtain ⟨hT, hR⟩ := Finset.mem_sigma.mp hTR have hc : anchor S = anchor T := congrArg Prod.fst heq have hQR : Q = R := congrArg Prod.snd heq have hWQ := mem_structuralWitnessPairs.mp hQ have hWR := mem_structuralWitnessPairs.mp hR have hTS : T = S := witness_pair_private hF hS hT (hanchor S hS).1 (by rw [hc]; exact (hanchor T hT).1) hWQ (by rw [hQR]; exact hWR.2.1.trans (Finset.erase_subset _ _)) subst T subst R rfl have hh := Finset.card_le_card_of_injOn f hmaps hinj simpa only [A, B, Finset.card_sigma, Finset.card_product, Finset.card_powersetCard, Nat.card_Icc, Nat.add_sub_cancel] using hh theorem witness_rich_family_card_le {N q C : ℕ} {F : Finset (Finset ℕ)} {H : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hwitness : ∀ S ∈ F, ∃ c ∈ S, c ∈ H ∧ q ≤ C * (structuralWitnessPairs S c).card) : F.card * q ≤ C * H.card * N.choose 2 := by classical have hex : ∀ S : Finset ℕ, ∃ c, S ∈ F → c ∈ S ∧ c ∈ H ∧ q ≤ C * (structuralWitnessPairs S c).card := by intro S by_cases hS : S ∈ F · obtain ⟨c, hc, hcH, hb⟩ := hwitness S hS exact ⟨c, fun _ => ⟨hc, hcH, hb⟩⟩ · exact ⟨0, fun hh => False.elim (hS hh)⟩ choose anchor hanchor using hex have hsum := Finset.sum_le_sum (s := F) (fun S hS => (hanchor S hS).2.2) simp only [Finset.sum_const, smul_eq_mul, ← Finset.mul_sum] at hsum have hbound := sum_variable_anchor_witnesses_le hF anchor (fun S hS => ⟨(hanchor S hS).1, (hanchor S hS).2.1⟩) have hh := hsum.trans (Nat.mul_le_mul_left C hbound) simpa only [Nat.mul_assoc] using hh end /- FarFromAP -/ /- Families far from arithmetic progressions are controlled by their private witnesses. -/ section open Finset theorem far_from_AP_witness_lower {N D c K t : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hc : c ∈ S) (hK : 0 < K) (hcard : 16*K + 1 ≤ S.card) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16 * (Nat.log 2 N + 1) * D^2 + D ≤ K) (ht : t ≤ K) (hfar : ∀ U ⊆ S, (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) → c ∈ U → t ≤ (S \ U).card) : t*K ≤ 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card := by rcases witness_or_AP_core hS hc hK hcard hdivisor hsize with hmany | hcore · have hh : t*K ≤ K^2 := by simpa only [pow_two] using Nat.mul_le_mul_right K ht exact hh.trans hmany · obtain ⟨U, hUS, hAP, hcU, hb⟩ := hcore exact (Nat.mul_le_mul_right K (hfar U hUS hAP hcU)).trans hb theorem far_from_AP_family_card_le {N D K t : ℕ} {F : Finset (Finset ℕ)} {H : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hK : 0 < K) (hcard : ∀ S ∈ F, 16*K + 1 ≤ S.card) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16 * (Nat.log 2 N + 1) * D^2 + D ≤ K) (ht : t ≤ K) (hhit : ∀ S ∈ F, (S ∩ H).Nonempty) (hfar : ∀ S ∈ F, ∀ U ⊆ S, (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) → t ≤ (S \ U).card) : F.card * (t*K) ≤ 4 * (Nat.log 2 N + 1) * H.card * N.choose 2 := by apply witness_rich_family_card_le hF intro S hS obtain ⟨c, hc⟩ := hhit S hS obtain ⟨hcS, hcH⟩ := Finset.mem_inter.mp hc exact ⟨c, hcS, hcH, far_from_AP_witness_lower (Finset.mem_powerset.mp (hF.1 hS)) hcS hK (hcard S hS) hdivisor hsize ht (fun U hUS hAP _ => hfar S hS U hUS hAP)⟩ theorem exists_maximal_AP_extension {S U : Finset ℕ} (hUS : U ⊆ S) (hAP : ∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) : ∃ P : Finset ℕ, U ⊆ P ∧ P ⊆ S ∧ (∃ l : ℕ∞, (P : Set ℕ).IsAPOfLength l) ∧ ∀ Q : Finset ℕ, P ⊆ Q → Q ⊆ S → (∃ l : ℕ∞, (Q : Set ℕ).IsAPOfLength l) → Q = P := by classical let A := S.powerset.filter (fun P => U ⊆ P ∧ ∃ l : ℕ∞, (P : Set ℕ).IsAPOfLength l) have hUA : U ∈ A := Finset.mem_filter.mpr ⟨Finset.mem_powerset.mpr hUS, Finset.Subset.refl _, hAP⟩ obtain ⟨P, hP, hmax⟩ := Finset.exists_max_image A Finset.card ⟨U, hUA⟩ obtain ⟨hPS, hUP, hPAP⟩ := Finset.mem_filter.mp hP refine ⟨P, hUP, Finset.mem_powerset.mp hPS, hPAP, ?_⟩ intro Q hPQ hQS hQAP have hQA : Q ∈ A := Finset.mem_filter.mpr ⟨Finset.mem_powerset.mpr hQS, hUP.trans hPQ, hQAP⟩ exact (Finset.eq_of_subset_of_card_le hPQ (hmax Q hQA)).symm theorem maximal_AP_core_of_few_witnesses {N D c K t : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hc : c ∈ S) (hK : 0 < K) (hcard : 16*K + 1 ≤ S.card) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16 * (Nat.log 2 N + 1) * D^2 + D ≤ K) (ht : t ≤ K) (hfew : 4 * (Nat.log 2 N + 1) * (structuralWitnessPairs S c).card < t*K) : ∃ P : Finset ℕ, P ⊆ S ∧ (∃ l : ℕ∞, (P : Set ℕ).IsAPOfLength l) ∧ c ∈ P ∧ (S \ P).card < t ∧ ∀ Q : Finset ℕ, P ⊆ Q → Q ⊆ S → (∃ l : ℕ∞, (Q : Set ℕ).IsAPOfLength l) → Q = P := by obtain ⟨U, hUS, hAP, hcU, hsmall⟩ := AP_core_of_few_witnesses hS hc hK hcard hdivisor hsize ht hfew obtain ⟨P, hUP, hPS, hPAP, hmax⟩ := exists_maximal_AP_extension hUS hAP refine ⟨P, hPS, hPAP, hUP hcU, ?_, hmax⟩ have hdiff : S \ P ⊆ S \ U := by intro x hx obtain ⟨hxS, hxP⟩ := Finset.mem_sdiff.mp hx exact Finset.mem_sdiff.mpr ⟨hxS, fun hxU => hxP (hUP hxU)⟩ exact (Finset.card_le_card hdiff).trans_lt hsmall end /- CorePoolCount -/ /- Counting disjoint remainders, and an intersection constraint on large core classes. -/ section open Finset theorem disjoint_pieces_hit_bound {α ι : Type*} [DecidableEq α] (I : Finset ι) (piece : ι → Finset α) (U : Finset α) (hdisj : ∀ i ∈ I, ∀ j ∈ I, i ≠ j → Disjoint (piece i) (piece j)) (hhit : ∀ i ∈ I, (piece i ∩ U).Nonempty) : I.card ≤ U.card := by classical choose x hx using (fun i : {i // i ∈ I} => hhit i.val i.property) have hmaps : Set.MapsTo x ((Finset.univ : Finset {i // i ∈ I}) : Set {i // i ∈ I}) (U : Set α) := by intro i hi exact (Finset.mem_inter.mp (hx i)).2 have hinj : Function.Injective x := by intro i j hij apply Subtype.ext by_contra hne have hd := hdisj i.val i.property j.val j.property hne exact Finset.disjoint_left.mp hd (Finset.mem_inter.mp (hx i)).1 (by simpa only [hij] using (Finset.mem_inter.mp (hx j)).1) simpa only [Finset.card_univ, Fintype.card_coe] using Finset.card_le_card_of_injOn x hmaps hinj.injOn theorem exists_piece_disjoint_of_card_lt {α ι : Type*} [DecidableEq α] (I : Finset ι) (piece : ι → Finset α) (U : Finset α) (hdisj : ∀ i ∈ I, ∀ j ∈ I, i ≠ j → Disjoint (piece i) (piece j)) (hcard : U.card < I.card) : ∃ i ∈ I, Disjoint (piece i) U := by classical by_contra hn have hhit : ∀ i ∈ I, (piece i ∩ U).Nonempty := by intro i hi by_contra hempty apply hn refine ⟨i, hi, Finset.disjoint_left.mpr ?_⟩ intro x hx hU exact hempty ⟨x, Finset.mem_inter.mpr ⟨hx, hU⟩⟩ have hh := disjoint_pieces_hit_bound I piece U hdisj hhit omega theorem heavy_core_pools_intersect {α : Type*} [DecidableEq α] {F G : Finset (Finset α)} {U V : Finset α} {s : ℕ} (core : Finset α → Finset α) (hFU : ∀ S ∈ F, core S ⊆ U) (hGV : ∀ T ∈ G, core T ⊆ V) (hFdisj : ∀ S ∈ F, ∀ T ∈ F, S ≠ T → Disjoint (S \ core S) (T \ core T)) (hGdisj : ∀ S ∈ G, ∀ T ∈ G, S ≠ T → Disjoint (S \ core S) (T \ core T)) (hcross : ∀ S ∈ F, ∀ T ∈ G, (S ∩ T).Nonempty) (hsmall : ∀ T ∈ G, T.card ≤ s) (hFlarge : s < F.card) (hGlarge : U.card < G.card) : (U ∩ V).Nonempty := by classical by_contra hempty have hUV : Disjoint U V := Finset.disjoint_left.mpr (fun x hx hy => hempty ⟨x, Finset.mem_inter.mpr ⟨hx, hy⟩⟩) obtain ⟨T, hT, hTU⟩ := exists_piece_disjoint_of_card_lt G (fun T => T \ core T) U hGdisj hGlarge have hTfull : Disjoint T U := by apply Finset.disjoint_left.mpr intro x hxT hxU by_cases hxcore : x ∈ core T · exact Finset.disjoint_left.mp hUV hxU (hGV T hT hxcore) · exact Finset.disjoint_left.mp hTU (Finset.mem_sdiff.mpr ⟨hxT, hxcore⟩) hxU have hhit : ∀ S ∈ F, ((S \ core S) ∩ T).Nonempty := by intro S hS obtain ⟨x, hx⟩ := hcross S hS T hT obtain ⟨hxS, hxT⟩ := Finset.mem_inter.mp hx refine ⟨x, Finset.mem_inter.mpr ⟨Finset.mem_sdiff.mpr ⟨hxS, ?_⟩, hxT⟩⟩ intro hxcore exact Finset.disjoint_left.mp hTfull hxT (hFU S hS hxcore) have hh := (disjoint_pieces_hit_bound F (fun S => S \ core S) T hFdisj hhit).trans (hsmall T hT) omega end /- CoreOverlap -/ /- Long overlap forces an AP intersection to stay inside a nearly full maximal core. -/ section open Finset theorem AP_subset_core_of_long_overlap {S P Q : Finset ℕ} {a b d k K : ℕ} (hd : 0 < d) (hPform : P = natAP b d k) (hPS : P ⊆ S) (hQS : Q ⊆ S) (hQAP : ∃ l : ℕ∞, (Q : Set ℕ).IsAPOfLength l) (hlong : natAP a d (K+1) ⊆ P ∩ Q) (hsmall : (S \ P).card < K) (hmax : ∀ U : Finset ℕ, P ⊆ U → U ⊆ S → (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) → U = P) : Q ⊆ P := by have hK : 0 < K := by omega have ha : a ∈ P ∩ Q := hlong (mem_natAP.mpr ⟨0, by omega, by simp⟩) have hv : a+d ∈ P ∩ Q := hlong (mem_natAP.mpr ⟨1, by omega, by simp⟩) have hlast : a+K*d ∈ P ∩ Q := hlong (mem_natAP.mpr ⟨K, by omega, rfl⟩) have haQ := (Finset.mem_inter.mp ha).2 have hvQ := (Finset.mem_inter.mp hv).2 have hlastQ := (Finset.mem_inter.mp hlast).2 have hQcard : 2 ≤ Q.card := by have hh : {a, a+d} ⊆ Q := by simp [Finset.insert_subset_iff, haQ, hvQ] simpa only [Finset.card_pair (by omega : a ≠ a+d)] using Finset.card_le_card hh obtain ⟨l, hl⟩ := hQAP obtain ⟨q, e, he, hQform⟩ := nat_ap_eq_natAP hl hQcard have hediv : e ∣ d := by have hh := natAP_dvd_anchorDistance (hQform ▸ haQ) (hQform ▸ hvQ) simpa only [anchorDistance, Nat.min_eq_left (by omega : a ≤ a+d), Nat.max_eq_right (by omega : a ≤ a+d), Nat.add_sub_cancel_left] using hh have hed : e ≤ d := Nat.le_of_dvd hd hediv have heq : e = d := by by_contra hne have hlt : e < d := by omega have hseg : Q ∩ Finset.Icc a (a+K*d) = apSegment a (a+K*d) e := by have hh := natAP_inter_Icc_eq_segment he (hQform ▸ haQ) (hQform ▸ hlastQ) (by omega : a ≤ a+K*d) rw [← hQform] at hh exact hh let f : ℕ → ℕ := fun i => a+i*d+e have hmaps : Set.MapsTo f (Finset.range K : Set ℕ) ((S \ P : Finset ℕ) : Set ℕ) := by intro i hi have hiK := Finset.mem_range.mp hi have hyQ : f i ∈ Q := by have hySeg : f i ∈ apSegment a (a+K*d) e := by refine Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨by dsimp [f]; omega, ?_⟩, ?_⟩ · dsimp [f] nlinarith only [hiK, hed] · have hh : e ∣ i*d+e := dvd_add (dvd_mul_of_dvd_right hediv i) (dvd_refl e) simpa only [f, Nat.add_assoc, Nat.add_sub_cancel_left] using hh rw [← hseg] at hySeg exact (Finset.mem_inter.mp hySeg).1 refine Finset.mem_sdiff.mpr ⟨hQS hyQ, ?_⟩ intro hyP have haP := (Finset.mem_inter.mp ha).1 have hh := natAP_dvd_anchorDistance (hPform ▸ haP) (hPform ▸ hyP) have hdist : anchorDistance a (f i) = i*d+e := by dsimp [anchorDistance, f]; omega rw [hdist] at hh have hdive : d ∣ e := by have hh' := Nat.dvd_sub hh (dvd_mul_left d i) simpa only [Nat.add_sub_cancel_left] using hh' have hde := Nat.le_of_dvd he hdive omega have hinj : Function.Injective f := by intro i j hij dsimp [f] at hij nlinarith only [hij, hd] have hcount := Finset.card_le_card_of_injOn f hmaps hinj.injOn rw [Finset.card_range] at hcount omega have haP := (Finset.mem_inter.mp ha).1 have hvP := (Finset.mem_inter.mp hv).1 have hconP : ConsecutiveIn P a (a+d) := by have hh := natAP_consecutive_of_neighbor hd (hPform ▸ haP) (hPform ▸ hvP) rwa [← hPform] at hh have hconQ : ConsecutiveIn Q a (a+d) := by have hvQ' : a+e ∈ Q := by simpa only [heq] using hvQ have hh := natAP_consecutive_of_neighbor he (hQform ▸ haQ) (hQform ▸ hvQ') rw [← hQform, heq] at hh exact hh have hPAP : ∃ l : ℕ∞, (P : Set ℕ).IsAPOfLength l := by rw [hPform] exact ⟨_, natAP_isAP hd⟩ have hunion := isAP_union_of_consecutive hPAP ⟨l, hl⟩ hconP hconQ have heqUnion := hmax (P ∪ Q) (Finset.subset_union_left) (Finset.union_subset hPS hQS) hunion exact heqUnion ▸ Finset.subset_union_right theorem core_remainder_private_of_long_overlap {N a b d k K : ℕ} {F : Finset (Finset ℕ)} {S T P : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hS : S ∈ F) (hT : T ∈ F) (hne : S ≠ T) (hd : 0 < d) (hPform : P = natAP b d k) (hPS : P ⊆ S) (hlongP : natAP a d (K+1) ⊆ P) (hlongT : natAP a d (K+1) ⊆ T) (hsmall : (S \ P).card < K) (hmax : ∀ U : Finset ℕ, P ⊆ U → U ⊆ S → (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) → U = P) : Disjoint (S \ P) T := by obtain ⟨l, hl, hAP⟩ := hF.2 hS hT hne have hlong : natAP a d (K+1) ⊆ P ∩ (S ∩ T) := by intro x hx exact Finset.mem_inter.mpr ⟨hlongP hx, Finset.mem_inter.mpr ⟨hPS (hlongP hx), hlongT hx⟩⟩ have hsub := AP_subset_core_of_long_overlap hd hPform hPS Finset.inter_subset_left ⟨l, hAP⟩ hlong hsmall hmax exact Finset.disjoint_left.mpr (fun x hxS hxT => (Finset.mem_sdiff.mp hxS).2 (hsub (Finset.mem_inter.mpr ⟨(Finset.mem_sdiff.mp hxS).1, hxT⟩))) theorem common_prefix_remainders_disjoint {N a d K : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hd : 0 < d) (core : Finset ℕ → Finset ℕ) (hform : ∀ S ∈ F, ∃ b k, core S = natAP b d k) (hsub : ∀ S ∈ F, core S ⊆ S) (hprefix : ∀ S ∈ F, natAP a d (K+1) ⊆ core S) (hsmall : ∀ S ∈ F, (S \ core S).card < K) (hmax : ∀ S ∈ F, ∀ U : Finset ℕ, core S ⊆ U → U ⊆ S → (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) → U = core S) : ∀ S ∈ F, ∀ T ∈ F, S ≠ T → Disjoint (S \ core S) (T \ core T) := by intro S hS T hT hne obtain ⟨b, k, hcore⟩ := hform S hS have hh := core_remainder_private_of_long_overlap hF hS hT hne hd hcore (hsub S hS) (hprefix S hS) ((hprefix T hT).trans (hsub T hT)) (hsmall S hS) (hmax S hS) exact Finset.disjoint_left.mpr (fun x hx hy => Finset.disjoint_left.mp hh hx (Finset.mem_sdiff.mp hy).1) theorem crooked_disjoint_remainders_card_le {N : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (core : Finset ℕ → Finset ℕ) (hcrooked : ∀ S ∈ F, IsCrooked S) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (core S : Set ℕ).IsAPOfLength l) (hsub : ∀ S ∈ F, core S ⊆ S) (hdisj : ∀ S ∈ F, ∀ T ∈ F, S ≠ T → Disjoint (S \ core S) (T \ core T)) : F.card ≤ N := by have hhit : ∀ S ∈ F, ((S \ core S) ∩ Finset.Icc 1 N).Nonempty := by intro S hS have hne : (S \ core S).Nonempty := by by_contra hn have hSP : S ⊆ core S := by intro x hx by_contra hxp exact hn ⟨x, Finset.mem_sdiff.mpr ⟨hx, hxp⟩⟩ have heq := Finset.Subset.antisymm hSP (hsub S hS) exact hcrooked S hS (by rw [heq]; exact hAP S hS) obtain ⟨x, hx⟩ := hne exact ⟨x, Finset.mem_inter.mpr ⟨hx, Finset.mem_powerset.mp (hF.1 hS) (Finset.mem_sdiff.mp hx).1⟩⟩ simpa only [Nat.card_Icc, Nat.add_sub_cancel] using disjoint_pieces_hit_bound F (fun S => S \ core S) (Finset.Icc 1 N) hdisj hhit end /- CoreWindows -/ /- Uniform lattice windows for nearly full AP cores with nearby starting points. -/ section open Finset def apStartCode (d K a : ℕ) : ℕ × ℕ := (a % d, (a / d) / K) def coreWindow (d K : ℕ) (q : ℕ × ℕ) : Finset ℕ := natAP (q.1 + q.2*K*d) d (65*K) def coreWindowPrefix (d K : ℕ) (q : ℕ × ℕ) : Finset ℕ := natAP (q.1 + (q.2+1)*K*d) d (K+1) theorem ap_start_decomposition {d K a : ℕ} (hK : 0 < K) : ∃ j < K, a = (apStartCode d K a).1 + ((apStartCode d K a).2*K+j)*d := by refine ⟨(a/d)%K, Nat.mod_lt _ hK, ?_⟩ have h1 := Nat.mod_add_div a d have h2 := Nat.mod_add_div (a/d) K dsimp [apStartCode] nlinarith only [h1, congrArg (fun n => n*d) h2] theorem natAP_subset_coreWindow {a d k K : ℕ} (hK : 0 < K) (hk : k ≤ 64*K) : natAP a d k ⊆ coreWindow d K (apStartCode d K a) := by obtain ⟨j, hj, ha⟩ := ap_start_decomposition (a := a) (d := d) hK intro x hx obtain ⟨i, hi, rfl⟩ := mem_natAP.mp hx apply mem_natAP.mpr refine ⟨j+i, by omega, ?_⟩ nlinarith only [ha] theorem coreWindowPrefix_subset_natAP {a d k K : ℕ} (hK : 0 < K) (hk : 2*K+1 ≤ k) : coreWindowPrefix d K (apStartCode d K a) ⊆ natAP a d k := by obtain ⟨j, hj, ha⟩ := ap_start_decomposition (a := a) (d := d) hK intro x hx obtain ⟨i, hi, rfl⟩ := mem_natAP.mp hx apply mem_natAP.mpr refine ⟨K-j+i, by omega, ?_⟩ have hsum : K-j+j = K := by omega nlinarith only [ha, congrArg (fun n => n*d) hsum] theorem card_coreWindow {d K : ℕ} (hd : 0 < d) (q : ℕ × ℕ) : (coreWindow d K q).card = 65*K := card_natAP hd theorem coreWindow_inter_code_bounds {d K : ℕ} {q r : ℕ × ℕ} (hd : 0 < d) (hK : 0 < K) (hq : q.1 < d) (hr : r.1 < d) (hinter : (coreWindow d K q ∩ coreWindow d K r).Nonempty) : q.1 = r.1 ∧ q.2 ≤ r.2+65 ∧ r.2 ≤ q.2+65 := by obtain ⟨x, hx⟩ := hinter obtain ⟨hxq, hxr⟩ := Finset.mem_inter.mp hx obtain ⟨i, hi, hix⟩ := mem_natAP.mp hxq obtain ⟨j, hj, hjx⟩ := mem_natAP.mp hxr change q.1 + q.2*K*d + i*d = x at hix change r.1 + r.2*K*d + j*d = x at hjx have hres : q.1 = r.1 := by have hmod := congrArg (fun n => n % d) (hix.trans hjx.symm) simpa only [Nat.add_mul_mod_self_right, Nat.mod_eq_of_lt hq, Nat.mod_eq_of_lt hr] using hmod have hindex : q.2*K+i = r.2*K+j := by rw [hres] at hix nlinarith only [hix, hjx, hd] refine ⟨hres, ?_, ?_⟩ · by_contra hn have hh : r.2+65 < q.2 := by omega have hm := Nat.mul_le_mul_right K (by omega : r.2+66 ≤ q.2) nlinarith only [hm, hindex, hj, hK] · by_contra hn have hm := Nat.mul_le_mul_right K (by omega : q.2+66 ≤ r.2) nlinarith only [hm, hindex, hi, hK] def startCodePool (N d K : ℕ) : Finset (ℕ × ℕ) := Finset.range d ×ˢ Finset.range (N/(K*d)+1) theorem apStartCode_mem_pool {N d K a : ℕ} (hd : 0 < d) (hK : 0 < K) (ha : a ≤ N) : apStartCode d K a ∈ startCodePool N d K := by refine Finset.mem_product.mpr ⟨Finset.mem_range.mpr (Nat.mod_lt _ hd), ?_⟩ apply Finset.mem_range.mpr change (a/d)/K < N/(K*d)+1 rw [Nat.div_div_eq_div_mul] simpa only [Nat.mul_comm d K] using Nat.lt_succ_of_le (Nat.div_le_div_right ha) theorem startCodePool_card_mul_le {N d K : ℕ} (hd : 0 < d) (hK : 0 < K) (hdN : d*K ≤ N) : (startCodePool N d K).card * K ≤ 2*N := by have hh := Nat.div_mul_le_self N (K*d) simp only [startCodePool, Finset.card_product, Finset.card_range] nlinarith only [hh, hdN] end /- WindowClassCount -/ /- Only a bounded number of lattice-window classes can be large. -/ section open Finset theorem window_class_sum_card_le {N d K : ℕ} {B : Finset (ℕ × ℕ)} (hd : 0 < d) (hK : 0 < K) (hdN : d*K ≤ N) (hB : B ⊆ startCodePool N d K) (family : (ℕ × ℕ) → Finset (Finset ℕ)) (core : Finset ℕ → Finset ℕ) (hcore : ∀ q ∈ B, ∀ S ∈ family q, core S ⊆ coreWindow d K q) (hdisj : ∀ q ∈ B, ∀ S ∈ family q, ∀ T ∈ family q, S ≠ T → Disjoint (S \ core S) (T \ core T)) (hcross : ∀ q ∈ B, ∀ r ∈ B, ∀ S ∈ family q, ∀ T ∈ family r, (S ∩ T).Nonempty) (hsmall : ∀ q ∈ B, ∀ S ∈ family q, S.card ≤ 64*K) (hlinear : ∀ q ∈ B, (family q).card ≤ N) : (∑ q ∈ B, (family q).card) ≤ 261*N := by classical let H := B.filter (fun q => 65*K < (family q).card) have hHB : H ⊆ B := Finset.filter_subset _ _ have hHcard : H.card ≤ 131 := by rcases H.eq_empty_or_nonempty with hzero | hne · simp [hzero] obtain ⟨q₀, hq₀⟩ := hne have hq₀B := hHB hq₀ have hq₀large := (Finset.mem_filter.mp hq₀).2 have hbound : ∀ q ∈ H, q.1 = q₀.1 ∧ q.2 ≤ q₀.2+65 ∧ q₀.2 ≤ q.2+65 := by intro q hq have hqB := hHB hq have hqLarge := (Finset.mem_filter.mp hq).2 have hinter := heavy_core_pools_intersect core (hcore q hqB) (hcore q₀ hq₀B) (hdisj q hqB) (hdisj q₀ hq₀B) (hcross q hqB q₀ hq₀B) (hsmall q₀ hq₀B) (by omega : 64*K < (family q).card) (by simpa only [card_coreWindow hd] using hq₀large) exact coreWindow_inter_code_bounds hd hK (Finset.mem_range.mp (Finset.mem_product.mp (hB hqB)).1) (Finset.mem_range.mp (Finset.mem_product.mp (hB hq₀B)).1) hinter have hmaps : Set.MapsTo Prod.snd (H : Set (ℕ × ℕ)) (Finset.Icc (q₀.2-65) (q₀.2+65) : Set ℕ) := by intro q hq have hh := hbound q hq exact Finset.mem_Icc.mpr ⟨by omega, hh.2.1⟩ have hinj : Set.InjOn Prod.snd (H : Set (ℕ × ℕ)) := by intro q hq r hr heq exact Prod.ext ((hbound q hq).1.trans (hbound r hr).1.symm) heq have hh := Finset.card_le_card_of_injOn Prod.snd hmaps hinj rw [Nat.card_Icc] at hh omega have hlight : ∑ q ∈ B \ H, (family q).card ≤ B.card * (65*K) := by have hh : ∑ q ∈ B \ H, (family q).card ≤ (B \ H).card * (65*K) := by have hpoint : ∀ q ∈ B \ H, (family q).card ≤ 65*K := by intro q hq obtain ⟨hqB, hqH⟩ := Finset.mem_sdiff.mp hq have hnot : ¬ 65*K < (family q).card := fun hn => hqH (Finset.mem_filter.mpr ⟨hqB, hn⟩) omega simpa only [Finset.sum_const, smul_eq_mul] using Finset.sum_le_sum hpoint exact hh.trans (Nat.mul_le_mul_right _ (Finset.card_le_card Finset.sdiff_subset)) have hheavy : ∑ q ∈ H, (family q).card ≤ 131*N := by have hh : ∑ q ∈ H, (family q).card ≤ H.card*N := by simpa only [Finset.sum_const, smul_eq_mul] using Finset.sum_le_sum (fun q hq => hlinear q (hHB hq)) exact hh.trans (Nat.mul_le_mul_right N hHcard) have hpartition := Finset.sum_sdiff hHB (f := fun q => (family q).card) have hpool := startCodePool_card_mul_le hd hK hdN have hBsize := (Nat.mul_le_mul_right K (Finset.card_le_card hB)).trans hpool have hlight' : ∑ q ∈ B \ H, (family q).card ≤ 130*N := by have hh := Nat.mul_le_mul_left 65 hBsize nlinarith only [hlight, hh] omega end /- NearAPCount -/ /- A linear bound per common difference for families with nearly full maximal AP cores. -/ section open Finset theorem nearAP_same_step_card_le {N d K : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hd : 0 < d) (hK : 0 < K) (start length : Finset ℕ → ℕ) (hcrooked : ∀ S ∈ F, IsCrooked S) (hcard : ∀ S ∈ F, S.card ≤ 64*K) (hsub : ∀ S ∈ F, natAP (start S) d (length S) ⊆ S) (hlow : ∀ S ∈ F, 2*K+1 ≤ length S) (hhigh : ∀ S ∈ F, length S ≤ 64*K) (hsmall : ∀ S ∈ F, (S \ natAP (start S) d (length S)).card < K) (hmax : ∀ S ∈ F, ∀ U : Finset ℕ, natAP (start S) d (length S) ⊆ U → U ⊆ S → (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) → U = natAP (start S) d (length S)) : F.card ≤ 261*N := by classical rcases F.eq_empty_or_nonempty with hzero | hne · simp [hzero] let core : Finset ℕ → Finset ℕ := fun S => natAP (start S) d (length S) let code : Finset ℕ → ℕ × ℕ := fun S => apStartCode d K (start S) let B := startCodePool N d K let family : (ℕ × ℕ) → Finset (Finset ℕ) := fun q => F.filter (fun S => code S = q) have hstartN : ∀ S ∈ F, start S ≤ N := by intro S hS have hlen := hlow S hS have ha : start S ∈ S := hsub S hS (mem_natAP.mpr ⟨0, by omega, by simp⟩) exact (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 hS) ha)).2 have hdN : d*K ≤ N := by obtain ⟨S, hS⟩ := hne have hlen := hlow S hS have hx : start S + K*d ∈ S := hsub S hS (mem_natAP.mpr ⟨K, by omega, rfl⟩) have hh := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 hS) hx)).2 nlinarith only [hh] have hfamilySub : ∀ q, family q ⊆ F := fun q => Finset.filter_subset _ _ have hprefix : ∀ q, ∀ S ∈ family q, coreWindowPrefix d K q ⊆ core S := by intro q S hS have hSF := hfamilySub q hS have heq := (Finset.mem_filter.mp hS).2 have hh := coreWindowPrefix_subset_natAP (a := start S) (d := d) hK (hlow S hSF) change code S = q at heq change coreWindowPrefix d K (code S) ⊆ core S at hh simpa only [heq] using hh have hdisj : ∀ q, ∀ S ∈ family q, ∀ T ∈ family q, S ≠ T → Disjoint (S \ core S) (T \ core T) := by intro q apply common_prefix_remainders_disjoint (arithInterSet_mono hF (hfamilySub q)) hd core (fun S _ => ⟨start S, length S, rfl⟩) (fun S hS => hsub S (hfamilySub q hS)) (hprefix q) (fun S hS => hsmall S (hfamilySub q hS)) (fun S hS => hmax S (hfamilySub q hS)) have hlinear : ∀ q, (family q).card ≤ N := by intro q exact crooked_disjoint_remainders_card_le (arithInterSet_mono hF (hfamilySub q)) core (fun S hS => hcrooked S (hfamilySub q hS)) (fun S _ => ⟨_, natAP_isAP hd⟩) (fun S hS => hsub S (hfamilySub q hS)) (hdisj q) have hsum := window_class_sum_card_le (B := B) hd hK hdN (Finset.Subset.refl _) family core (by intro q hq S hS have hh := natAP_subset_coreWindow (a := start S) (d := d) hK (hhigh S (hfamilySub q hS)) have heq := (Finset.mem_filter.mp hS).2 change code S = q at heq change core S ⊆ coreWindow d K (code S) at hh simpa only [heq] using hh) (fun q _ => hdisj q) (by intro q hq r hr S hS T hT have hSF := hfamilySub q hS have hTF := hfamilySub r hT have hSne : S.Nonempty := Finset.card_pos.mp (by have hh := (hcrooked S hSF).card_three_le omega) exact arithInter_inter_nonempty hF hSF hTF hSne) (fun q _ S hS => hcard S (hfamilySub q hS)) (fun q _ => hlinear q) have hmaps : ∀ S ∈ F, code S ∈ B := fun S hS => apStartCode_mem_pool hd hK (hstartN S hS) have hpartition : F.card = ∑ q ∈ B, (family q).card := Finset.card_eq_sum_card_fiberwise hmaps rw [hpartition] exact hsum theorem nearAP_family_card_mul_le {N K : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hK : 0 < K) (start step length : Finset ℕ → ℕ) (hcrooked : ∀ S ∈ F, IsCrooked S) (hcard : ∀ S ∈ F, S.card ≤ 64*K) (hstep : ∀ S ∈ F, 0 < step S) (hsub : ∀ S ∈ F, natAP (start S) (step S) (length S) ⊆ S) (hlow : ∀ S ∈ F, 2*K+1 ≤ length S) (hhigh : ∀ S ∈ F, length S ≤ 64*K) (hsmall : ∀ S ∈ F, (S \ natAP (start S) (step S) (length S)).card < K) (hmax : ∀ S ∈ F, ∀ U : Finset ℕ, natAP (start S) (step S) (length S) ⊆ U → U ⊆ S → (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) → U = natAP (start S) (step S) (length S)) : F.card*K ≤ 261*N^2 := by classical let family : ℕ → Finset (Finset ℕ) := fun d => F.filter (fun S => step S = d) have hfamilySub : ∀ d, family d ⊆ F := fun d => Finset.filter_subset _ _ have hmaps : ∀ S ∈ F, step S ∈ Finset.Icc 1 (N/K) := by intro S hS have hlen := hlow S hS have hx : start S + K*step S ∈ S := hsub S hS (mem_natAP.mpr ⟨K, by omega, rfl⟩) have hxN := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 hS) hx)).2 refine Finset.mem_Icc.mpr ⟨hstep S hS, (Nat.le_div_iff_mul_le hK).mpr ?_⟩ nlinarith only [hxN] have hbound : ∀ d ∈ Finset.Icc 1 (N/K), (family d).card ≤ 261*N := by intro d hd apply nearAP_same_step_card_le (arithInterSet_mono hF (hfamilySub d)) (Finset.mem_Icc.mp hd).1 hK start length (fun S hS => hcrooked S (hfamilySub d hS)) (fun S hS => hcard S (hfamilySub d hS)) · intro S hS have hh := hsub S (hfamilySub d hS) simpa only [(Finset.mem_filter.mp hS).2] using hh · exact fun S hS => hlow S (hfamilySub d hS) · exact fun S hS => hhigh S (hfamilySub d hS) · intro S hS have hh := hsmall S (hfamilySub d hS) simpa only [(Finset.mem_filter.mp hS).2] using hh · intro S hS have hh := hmax S (hfamilySub d hS) simpa only [(Finset.mem_filter.mp hS).2] using hh have hsum := Finset.sum_le_sum hbound simp only [Finset.sum_const, smul_eq_mul, Nat.card_Icc, Nat.add_sub_cancel] at hsum have hpartition : F.card = ∑ d ∈ Finset.Icc 1 (N/K), (family d).card := Finset.card_eq_sum_card_fiberwise hmaps rw [← hpartition] at hsum have hm := Nat.mul_le_mul_right K hsum have hdiv := Nat.mul_le_mul_left (261*N) (Nat.div_mul_le_self N K) nlinarith only [hm, hdiv] end /- MediumCrooked -/ /- A quantitative bound for crooked members in one size band. -/ section open Finset def HasNearAPCore (K : ℕ) (S : Finset ℕ) : Prop := ∃ P : Finset ℕ, P ⊆ S ∧ (∃ l : ℕ∞, (P : Set ℕ).IsAPOfLength l) ∧ 2*K+1 ≤ P.card ∧ (S \ P).card < K ∧ ∀ U : Finset ℕ, P ⊆ U → U ⊆ S → (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) → U = P theorem hasNearAPCore_of_approximation {K : ℕ} {S U : Finset ℕ} (hcard : 16*K+1 ≤ S.card) (hUS : U ⊆ S) (hAP : ∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) (hsmall : (S \ U).card < K) : HasNearAPCore K S := by obtain ⟨P, hUP, hPS, hPAP, hmax⟩ := exists_maximal_AP_extension hUS hAP have hdiff : S \ P ⊆ S \ U := by intro x hx obtain ⟨hxS, hxP⟩ := Finset.mem_sdiff.mp hx exact Finset.mem_sdiff.mpr ⟨hxS, fun hxU => hxP (hUP hxU)⟩ have hPsmall := (Finset.card_le_card hdiff).trans_lt hsmall refine ⟨P, hPS, hPAP, ?_, hPsmall, hmax⟩ have hh := Finset.card_sdiff_add_card_eq_card hPS omega theorem nearAP_core_family_card_mul_le {N K : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hK : 0 < K) (hcrooked : ∀ S ∈ F, IsCrooked S) (hcard : ∀ S ∈ F, S.card ≤ 64*K) (hnear : ∀ S ∈ F, HasNearAPCore K S) : F.card*K ≤ 261*N^2 := by classical have hex : ∀ S : Finset ℕ, ∃ a d k : ℕ, S ∈ F → 0 < d ∧ natAP a d k ⊆ S ∧ 2*K+1 ≤ k ∧ k ≤ 64*K ∧ (S \ natAP a d k).card < K ∧ ∀ U : Finset ℕ, natAP a d k ⊆ U → U ⊆ S → (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) → U = natAP a d k := by intro S by_cases hS : S ∈ F · obtain ⟨P, hPS, ⟨l, hl⟩, hPlow, hPsmall, hPmax⟩ := hnear S hS obtain ⟨a, d, hd, hrep⟩ := nat_ap_eq_natAP hl (by omega) refine ⟨a, d, P.card, fun _ => ⟨hd, ?_, hPlow, (Finset.card_le_card hPS).trans (hcard S hS), ?_, ?_⟩⟩ · simpa only [← hrep] using hPS · simpa only [← hrep] using hPsmall · simpa only [← hrep] using hPmax · exact ⟨0, 1, 0, fun hh => False.elim (hS hh)⟩ choose start step length hspec using hex exact nearAP_family_card_mul_le hF hK start step length hcrooked hcard (fun S hS => (hspec S hS).1) (fun S hS => (hspec S hS).2.1) (fun S hS => (hspec S hS).2.2.1) (fun S hS => (hspec S hS).2.2.2.1) (fun S hS => (hspec S hS).2.2.2.2.1) (fun S hS => (hspec S hS).2.2.2.2.2) theorem crooked_size_band_card_mul_le {N D K : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hK : 0 < K) (hcrooked : ∀ S ∈ F, IsCrooked S) (hlow : ∀ S ∈ F, 16*K+1 ≤ S.card) (hhigh : ∀ S ∈ F, S.card ≤ 64*K) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16 * (Nat.log 2 N + 1) * D^2 + D ≤ K) : F.card*K ≤ 600 * (Nat.log 2 N + 1) * N^2 := by classical rcases F.eq_empty_or_nonempty with hzero | hne · simp [hzero] obtain ⟨R, hR⟩ := hne let A := F.filter (HasNearAPCore K) let B := F.filter (fun S => ¬ HasNearAPCore K S) have hAF : A ⊆ F := Finset.filter_subset _ _ have hBF : B ⊆ F := Finset.filter_subset _ _ have hnear := nearAP_core_family_card_mul_le (arithInterSet_mono hF hAF) hK (fun S hS => hcrooked S (hAF hS)) (fun S hS => hhigh S (hAF hS)) (fun S hS => (Finset.mem_filter.mp hS).2) have hfar : ∀ S ∈ B, ∀ U ⊆ S, (∃ l : ℕ∞, (U : Set ℕ).IsAPOfLength l) → K ≤ (S \ U).card := by intro S hS U hUS hAP by_contra hn exact (Finset.mem_filter.mp hS).2 (hasNearAPCore_of_approximation (hlow S (hBF hS)) hUS hAP (by omega)) have hhit : ∀ S ∈ B, (S ∩ R).Nonempty := by intro S hS have hSne : S.Nonempty := Finset.card_pos.mp (by have hh := (hcrooked S (hBF hS)).card_three_le omega) exact arithInter_inter_nonempty hF (hBF hS) hR hSne have hfarBound := far_from_AP_family_card_le (arithInterSet_mono hF hBF) hK (fun S hS => hlow S (hBF hS)) hdivisor hsize (Nat.le_refl K) hhit hfar have hRcard := hhigh R hR have hchoose : N.choose 2 ≤ N^2 := Nat.choose_le_pow N 2 have hprod := Nat.mul_le_mul hRcard hchoose have hmul := Nat.mul_le_mul_left (4 * (Nat.log 2 N + 1)) hprod have hfarFull : (B.card*K)*K ≤ (256 * (Nat.log 2 N + 1) * N^2)*K := by nlinarith only [hfarBound, hmul] have hfarFinal := Nat.le_of_mul_le_mul_right hfarFull hK have hpartition := Finset.card_filter_add_card_filter_not (s := F) (HasNearAPCore K) change A.card + B.card = F.card at hpartition have hsum : A.card*K + B.card*K = F.card*K := by rw [← Nat.add_mul, hpartition] have hlog : 1 ≤ Nat.log 2 N + 1 := by omega have hm := Nat.mul_le_mul_right (261*N^2) hlog nlinarith only [hnear, hfarFinal, hsum, hm, Nat.zero_le ((Nat.log 2 N + 1) * N^2)] end /- LargeCrooked -/ /- Summing size bands bounds every crooked member above a fixed cutoff. -/ section open Finset theorem large_crooked_card_mul_le_reciprocal {N D K : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hK : 0 < K) (hcrooked : ∀ S ∈ F, IsCrooked S) (hlow : ∀ S ∈ F, 16*K+1 ≤ S.card) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16 * (Nat.log 2 N + 1) * D^2 + D ≤ K) : (F.card : ℝ)*K ≤ 600 * (Nat.log 2 N + 1 : ℕ) * (N : ℝ)^2 * reciprocalSum N := by classical let level : Finset ℕ → ℕ := fun S => (S.card-1)/(16*K) let family : ℕ → Finset (Finset ℕ) := fun j => F.filter (fun S => level S = j) have hfamilySub : ∀ j, family j ⊆ F := fun j => Finset.filter_subset _ _ have hmaps : ∀ S ∈ F, level S ∈ Finset.Icc 1 N := by intro S hS have hmin := hlow S hS have hScard : S.card ≤ N := by simpa only [Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card (Finset.mem_powerset.mp (hF.1 hS)) refine Finset.mem_Icc.mpr ⟨?_, ?_⟩ · dsimp [level] apply (Nat.le_div_iff_mul_le (by positivity : 0 < 16*K)).mpr omega · exact (Nat.div_le_self _ _).trans (by omega) have hband : ∀ j ∈ Finset.Icc 1 N, (family j).card * (j*K) ≤ 600 * (Nat.log 2 N + 1) * N^2 := by intro j hj have hj1 := (Finset.mem_Icc.mp hj).1 have hscale : K ≤ j*K := by nlinarith only [hj1] apply crooked_size_band_card_mul_le (arithInterSet_mono hF (hfamilySub j)) (by positivity) (fun S hS => hcrooked S (hfamilySub j hS)) · intro S hS have hlevel : level S = j := (Finset.mem_filter.mp hS).2 have hprod := Nat.div_mul_le_self (S.card-1) (16*K) change level S * (16*K) ≤ S.card-1 at hprod rw [hlevel] at hprod have hpos := hlow S (hfamilySub j hS) have hsubeq : S.card-1+1 = S.card := by omega nlinarith only [hprod, hsubeq] · intro S hS have hlevel : level S = j := (Finset.mem_filter.mp hS).2 have hquot : (S.card-1)/(16*K) < j+1 := by change level S < j+1; omega have hupper := (Nat.div_lt_iff_lt_mul (by positivity : 0 < 16*K)).mp hquot have hpos := hlow S (hfamilySub j hS) have hsubeq : S.card-1+1 = S.card := by omega nlinarith only [hupper, hscale, hsubeq] · exact hdivisor · exact hsize.trans hscale have hrow : ∀ j ∈ Finset.Icc 1 N, ((family j).card : ℝ)*K ≤ (600 * (Nat.log 2 N + 1 : ℕ) * (N : ℝ)^2) * (j : ℝ)⁻¹ := by intro j hj have hjpos : (0 : ℝ) < j := by exact_mod_cast (Finset.mem_Icc.mp hj).1 have hh : ((family j).card : ℝ) * ((j : ℝ)*K) ≤ 600 * (Nat.log 2 N + 1 : ℕ) * (N : ℝ)^2 := by exact_mod_cast hband j hj rw [← div_eq_mul_inv] apply (le_div_iff₀ hjpos).mpr nlinarith only [hh] have hpartition : F.card = ∑ j ∈ Finset.Icc 1 N, (family j).card := Finset.card_eq_sum_card_fiberwise hmaps have hsum := Finset.sum_le_sum hrow have hleft : (∑ j ∈ Finset.Icc 1 N, ((family j).card : ℝ)*K) = (F.card : ℝ)*K := by rw [← Finset.sum_mul, ← Nat.cast_sum, ← hpartition] rw [hleft, ← Finset.mul_sum] at hsum exact hsum theorem large_crooked_card_mul_le {N D K : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hK : 0 < K) (hcrooked : ∀ S ∈ F, IsCrooked S) (hlow : ∀ S ∈ F, 16*K+1 ≤ S.card) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16 * (Nat.log 2 N + 1) * D^2 + D ≤ K) : F.card*K ≤ 1200 * (Nat.log 2 N + 1)^2 * N^2 := by have hh := large_crooked_card_mul_le_reciprocal hF hK hcrooked hlow hdivisor hsize have hrec := reciprocalSum_le_natLog N have hm := mul_le_mul_of_nonneg_left hrec (by positivity : (0 : ℝ) ≤ 600 * (Nat.log 2 N + 1 : ℕ) * (N : ℝ)^2) have hb : (F.card : ℝ)*K ≤ 1200 * ((Nat.log 2 N + 1 : ℕ) : ℝ)^2 * (N : ℝ)^2 := by push_cast at hh hm ⊢ nlinarith only [hh, hm] exact_mod_cast hb theorem crooked_no_common_point_card_mul_le {N D K s : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hK : 0 < K) (hcrooked : ∀ S ∈ F, IsCrooked S) (hbound : ∀ S ∈ F, S.card ≤ s) (hno : ∀ c ∈ Finset.Icc 1 N, ∃ T ∈ F, c ∉ T) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16 * (Nat.log 2 N + 1) * D^2 + D ≤ K) : F.card*K ≤ (s*N + 4*(16*K)^2*N + (32*K+1)*(48*N*(Nat.log 2 N + 1)^3))*K + 1200 * (Nat.log 2 N + 1)^2 * N^2 := by classical let A := F.filter (fun S => S.card ≤ 16*K) let B := F.filter (fun S => ¬ S.card ≤ 16*K) have hAF : A ⊆ F := Finset.filter_subset _ _ have hBF : B ⊆ F := Finset.filter_subset _ _ have hsmall := small_crooked_no_common_point_card_le hF hAF (fun S hS => hcrooked S (hAF hS)) (fun S hS => (Finset.mem_filter.mp hS).2) hbound hno have hsmall' := Nat.mul_le_mul_right K hsmall have hlarge := large_crooked_card_mul_le (arithInterSet_mono hF hBF) hK (fun S hS => hcrooked S (hBF hS)) (fun S hS => by have hh := (Finset.mem_filter.mp hS).2; omega) hdivisor hsize have hpartition := Finset.card_filter_add_card_filter_not (s := F) (fun S => S.card ≤ 16*K) change A.card + B.card = F.card at hpartition have hmul : A.card*K + B.card*K = F.card*K := by rw [← Nat.add_mul, hpartition] nlinarith only [hsmall', hlarge, hmul] end /- StructuralCutoff -/ /- A fourth-root cutoff makes every structural error subquadratic. -/ section open Finset Filter def structuralCutoff (N : ℕ) : ℕ := Nat.sqrt (Nat.sqrt N) theorem structuralCutoff_fourth_le (N : ℕ) : (structuralCutoff N)^4 ≤ N := by have h1 := Nat.sqrt_le' (Nat.sqrt N) have h2 := Nat.sqrt_le' N have hh := (Nat.pow_le_pow_left h1 2).trans h2 simpa only [structuralCutoff, ← pow_mul] using hh theorem le_structuralCutoff_of_fourth_le {a N : ℕ} (ha : a^4 ≤ N) : a ≤ structuralCutoff N := by apply Nat.le_sqrt'.mpr apply Nat.le_sqrt'.mpr simpa only [← pow_mul] using ha theorem eventually_log_cube_le_structuralCutoff (C : ℕ) : ∀ᶠ N : ℕ in atTop, C*(Nat.log 2 N + 1)^3 ≤ structuralCutoff N := by filter_upwards [eventually_natLog_pow_le 24, Filter.eventually_ge_atTop (C^8)] with N hlog hN have hpow : (C*(Nat.log 2 N + 1)^3)^8 ≤ N^2 := by calc (C*(Nat.log 2 N + 1)^3)^8 = C^8 * (Nat.log 2 N + 1)^24 := by ring _ ≤ C^8*N := Nat.mul_le_mul_left _ hlog _ ≤ N*N := Nat.mul_le_mul_right _ hN _ = N^2 := by ring have hfourth : (C*(Nat.log 2 N + 1)^3)^4 ≤ N := by apply (Nat.pow_le_pow_iff_left (by decide : 2 ≠ 0)).mp simpa only [← pow_mul] using hpow exact le_structuralCutoff_of_fourth_le hfourth theorem eventually_trace_threshold_le_structuralCutoff : ∀ᶠ N : ℕ in atTop, 16*(Nat.log 2 N + 1)*(squareDivisorBound N)^2 + squareDivisorBound N ≤ structuralCutoff N := by filter_upwards [eventually_natLog_pow_le 16, eventually_squareDivisorBound_pow_le 32, Filter.eventually_ge_atTop (17^8)] with N hlog hdiv hN let L := Nat.log 2 N + 1 let D := squareDivisorBound N let A := 16*L*D^2+D have hD : D ≤ D^2 := by nlinarith only [Nat.zero_le D] have hL : 1 ≤ L := by dsimp [L]; omega have hmul := Nat.mul_le_mul_right (D^2) hL have hA : A ≤ 17*L*D^2 := by dsimp [A]; nlinarith only [hD, hmul] have hpow : A^16 ≤ N^4 := by calc A^16 ≤ (17*L*D^2)^16 := Nat.pow_le_pow_left hA 16 _ = 17^16 * (L^16 * D^32) := by ring _ ≤ 17^16 * (N*N) := Nat.mul_le_mul_left _ (Nat.mul_le_mul hlog hdiv) _ ≤ N^2 * (N*N) := Nat.mul_le_mul_right _ (by have hh := Nat.pow_le_pow_left hN 2 simpa only [← pow_mul] using hh) _ = N^4 := by ring have hfourth : A^4 ≤ N := by apply (Nat.pow_le_pow_iff_left (by decide : 4 ≠ 0)).mp simpa only [← pow_mul] using hpow exact le_structuralCutoff_of_fourth_le hfourth end /- CrookedCommonPoint -/ /- The common-point reduction for a quadratically large sparse crooked family. -/ section open Finset Filter theorem structural_error_small {L K N : ℕ} (hL : 1 ≤ L) (hlog : 1000000000*L^3 ≤ K) (hroot : K^4 ≤ N) : 4000 * (1024*K^3*N + (32*K+1)*48*K*N*L^3 + 1200*L^2*N^2) ≤ 3*N^2*K := by have hLcube : 1 ≤ L^3 := by simpa only [one_pow] using Nat.pow_le_pow_left hL 3 have hKlarge : 1000000000 ≤ K := by have hh := Nat.mul_le_mul_left 1000000000 hLcube omega have hK : 1 ≤ K := by omega have hLL : L^2 ≤ L^3 := by have hh := Nat.mul_le_mul_left (L^2) hL nlinarith only [hh] have hKK : K^2 ≤ N := by have hk2 : 1 ≤ K^2 := by nlinarith only [hK] have hh := Nat.mul_le_mul_left (K^2) hk2 nlinarith only [hh, hroot] have hfirstCoef : 4096000*K^2 ≤ N := by have hk2 : 4096000 ≤ K^2 := by nlinarith only [hKlarge] have hh := Nat.mul_le_mul_right (K^2) hk2 nlinarith only [hh, hroot] have hsecondCoef : 6336000*L^3 ≤ K := by nlinarith only [hlog, Nat.zero_le (L^3)] have hthirdCoef : 4800000*L^2 ≤ K := by have hh := Nat.mul_le_mul_left 1000000000 hLL nlinarith only [hlog, hh, Nat.zero_le (L^2)] have hfirst : 4000*(1024*K^3*N) ≤ N^2*K := by have hh := Nat.mul_le_mul_right (K*N) hfirstCoef nlinarith only [hh] have hsecond : 4000*((32*K+1)*48*K*N*L^3) ≤ N^2*K := by have hrow : 32*K+1 ≤ 33*K := by omega have h1 := Nat.mul_le_mul_right (4000*48*K*N*L^3) hrow have h2 := Nat.mul_le_mul_right (K^2*N) hsecondCoef have h3 := Nat.mul_le_mul_right (K*N) hKK nlinarith only [h1, h2, h3] have hthird : 4000*(1200*L^2*N^2) ≤ N^2*K := by have hh := Nat.mul_le_mul_right (N^2) hthirdCoef nlinarith only [hh] nlinarith only [hfirst, hsecond, hthird] theorem sparse_crooked_common_point {N D K : ℕ} {F : Finset (Finset ℕ)} (hN : 0 < N) (hF : Erdos272.IsArithInterSet N F) (hcrooked : ∀ S ∈ F, IsCrooked S) (hsparse : ∀ S ∈ F, 16*S.card ≤ N) (hlarge : N^2 ≤ 14*F.card) (hdivisor : ∀ m ≤ N^2, m.divisors.card ≤ D) (hsize : 16*(Nat.log 2 N + 1)*D^2+D ≤ K) (hlog : 1000000000*(Nat.log 2 N + 1)^3 ≤ K) (hroot : K^4 ≤ N) : ∃ c ∈ Finset.Icc 1 N, ∀ S ∈ F, c ∈ S := by classical by_contra hcommon push_neg at hcommon have hK : 0 < K := by have hL : 1 ≤ (Nat.log 2 N + 1)^3 := by simpa only [one_pow] using Nat.pow_le_pow_left (by omega : 1 ≤ Nat.log 2 N + 1) 3 have hh := Nat.mul_le_mul_left 1000000000 hL omega have hbound : ∀ S ∈ F, S.card ≤ N/16 := by intro S hS apply (Nat.le_div_iff_mul_le (by decide : 0 < 16)).mpr simpa only [Nat.mul_comm S.card 16] using hsparse S hS have hupper := crooked_no_common_point_card_mul_le hF hK hcrooked hbound hcommon hdivisor hsize let L := Nat.log 2 N + 1 let E := 1024*K^3*N + (32*K+1)*48*K*N*L^3 + 1200*L^2*N^2 have herror : 4000*E ≤ 3*N^2*K := structural_error_small (by dsimp [L]; omega) hlog hroot have hupper' : F.card*K ≤ (N/16)*N*K + E := by dsimp [E, L] nlinarith only [hupper] have hbase : 16*((N/16)*N*K) ≤ N^2*K := by have hh := Nat.mul_le_mul_right (N*K) (Nat.div_mul_le_self N 16) nlinarith only [hh] have hlarge' := Nat.mul_le_mul_right K hlarge have hpos : 0 < N^2*K := by positivity nlinarith only [hupper', hbase, hlarge', herror, hpos] theorem eventually_sparse_crooked_common_point : ∀ᶠ N : ℕ in atTop, ∀ F : Finset (Finset ℕ), Erdos272.IsArithInterSet N F → (∀ S ∈ F, IsCrooked S) → (∀ S ∈ F, 16*S.card ≤ N) → N^2 ≤ 14*F.card → ∃ c ∈ Finset.Icc 1 N, ∀ S ∈ F, c ∈ S := by filter_upwards [eventually_trace_threshold_le_structuralCutoff, eventually_log_cube_le_structuralCutoff 1000000000, Filter.eventually_ge_atTop 1] with N hsize hlog hN intro F hF hcrooked hsparse hlarge exact sparse_crooked_common_point hN hF hcrooked hsparse hlarge (fun m hm => divisor_card_le_squareDivisorBound hm) hsize hlog (structuralCutoff_fourth_le N) end /- CommonPointReduction -/ /- Removing linearly many dense crooked members leaves a common crooked root. -/ section open Finset Filter theorem common_crooked_reduction_of_sparse_root {N c : ℕ} {F : Finset (Finset ℕ)} (hN : 64 ≤ N) (hF : Erdos272.IsArithInterSet N F) (hroot : ∀ S ∈ sparseCrookedMembers N F, c ∈ S) : ∃ G : Finset (Finset ℕ), G ⊆ F ∧ Erdos272.IsArithInterSet N G ∧ F.card ≤ G.card + 2048*N ∧ (∀ S ∈ G, IsCrooked S → c ∈ S) := by classical let D := (crookedMembers F).filter (fun S => ¬16*S.card ≤ N) let G := F \ D have hDF : D ⊆ F := by intro S hS exact (Finset.mem_filter.mp (Finset.mem_filter.mp hS).1).1 have hdense : D.card ≤ 2048*N := by apply dense_crooked_card_le hN (admissible_subfamily hF hDF) · intro S hS exact (Finset.mem_filter.mp (Finset.mem_filter.mp hS).1).2 · intro S hS have hh := (Finset.mem_filter.mp hS).2 omega refine ⟨G, Finset.sdiff_subset, admissible_subfamily hF Finset.sdiff_subset, ?_, ?_⟩ · exact (Finset.card_le_card_sdiff_add_card (s := F) (t := D)).trans (Nat.add_le_add_left hdense G.card) · intro S hS hcrooked obtain ⟨hSF, hSD⟩ := Finset.mem_sdiff.mp hS apply hroot S have hsparse : 16*S.card ≤ N := by by_contra hn exact hSD (Finset.mem_filter.mpr ⟨Finset.mem_filter.mpr ⟨hSF, hcrooked⟩, hn⟩) exact Finset.mem_filter.mpr ⟨Finset.mem_filter.mpr ⟨hSF, hcrooked⟩, hsparse⟩ theorem eventually_common_crooked_reduction : ∀ᶠ N : ℕ in atTop, ∀ F : Finset (Finset ℕ), Erdos272.IsArithInterSet N F → (N : ℝ)^2/2 ≤ (F.card : ℝ) → ∃ G : Finset (Finset ℕ), G ⊆ F ∧ Erdos272.IsArithInterSet N G ∧ F.card ≤ G.card + 2048*N ∧ ∃ c ∈ Finset.Icc 1 N, ∀ S ∈ G, IsCrooked S → c ∈ S := by classical filter_upwards [eventually_many_sparse_crooked_members, eventually_sparse_crooked_common_point, Filter.eventually_ge_atTop 64] with N hmany hcommon hN F hF hsize let C := sparseCrookedMembers N F have hCF : C ⊆ F := by intro S hS exact (Finset.mem_filter.mp (Finset.mem_filter.mp hS).1).1 have hcrooked : ∀ S ∈ C, IsCrooked S := by intro S hS exact (Finset.mem_filter.mp (Finset.mem_filter.mp hS).1).2 have hsparse : ∀ S ∈ C, 16*S.card ≤ N := by intro S hS exact (Finset.mem_filter.mp hS).2 have hlargeR : (N : ℝ)^2 ≤ 14*(C.card : ℝ) := by have hh := hmany F hF hsize change (N : ℝ)^2/14 ≤ (C.card : ℝ) at hh linarith only [hh] have hlarge : N^2 ≤ 14*C.card := by exact_mod_cast hlargeR obtain ⟨c, hc, hroot⟩ := hcommon C (admissible_subfamily hF hCF) hcrooked hsparse hlarge obtain ⟨G, hGF, hG, hcard, hGc⟩ := common_crooked_reduction_of_sparse_root hN hF hroot exact ⟨G, hGF, hG, hcard, c, hc, hGc⟩ end /- MatchingModels -/ /- Progression matching retaining the progression model used in the proof. -/ section open Finset theorem exists_natural_progression_pair_matching_with_models {N c : ℕ} {F : Finset (Finset ℕ)} (hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hcard : ∀ S ∈ F, 4 ≤ S.card) (hcenter : ∀ S ∈ F, c ∈ S) : ∃ f : {S // S ∈ F} → Option (ℕ × ℕ), (∀ S q, f S = some q → ∃ d : ℕ, 0 < d ∧ d ≤ N ∧ NaturalMatchedPair c d S.val q ∧ ∃ p : ProgressionCell, IsCenteredModel c d p S.val) ∧ (∀ S T q, f S = some q → f T = some q → S = T) ∧ ((Finset.univ.filter (fun S => f S = none)).card ≤ 20000 * N) := by classical let A := {S : Finset ℕ // S ∈ F} have hparam : ∀ S : A, ∃ d : ℕ, 0 < d ∧ d ≤ N ∧ ∃ p : ProgressionCell, IsCenteredModel c d p S.val := by intro S obtain ⟨l, hAPs⟩ := hAP S.val S.property exact exists_centered_model_bounded (hsub S.val S.property) hAPs (hcard S.val S.property) (hcenter S.val S.property) choose d hd hdN p hmodel using hparam obtain ⟨f, hreal, hrealinj, hexcept⟩ := exists_progression_pair_matching let g : A → Option (ℕ × ℕ) := fun S => (f (p S)).map (liftPair c (d S)) have hvalid : ∀ S q, g S = some q → NaturalMatchedPair c (d S) S.val q := by intro S q hq obtain ⟨r, hr, hrq⟩ := Option.map_eq_some_iff.mp hq rw [← hrq] exact liftPair_spec (hd S) (hmodel S) (hreal (p S) r hr) refine ⟨g, ?_, ?_, ?_⟩ · intro S q hq exact ⟨d S, hd S, hdN S, hvalid S q hq, p S, hmodel S⟩ · intro S T q hSq hTq have hSvalid := hvalid S q hSq have hTvalid := hvalid T q hTq have hdST : d S = d T := hSvalid.2.2.2.2.2.1.symm.trans hTvalid.2.2.2.2.2.1 obtain ⟨r, hr, hrq⟩ := Option.map_eq_some_iff.mp hSq obtain ⟨r', hr', hr'q⟩ := Option.map_eq_some_iff.mp hTq have hlifts : liftPair c (d T) r = liftPair c (d T) r' := by simpa only [hdST] using hrq.trans hr'q.symm have hrr' : r = r' := liftPair_injective_on_models (hd T) (by simpa only [hdST] using hmodel S) (hmodel T) (hreal (p S) r hr) (hreal (p T) r' hr') hlifts have hpST : p S = p T := hrealinj (p S) (p T) r hr (by simpa only [hrr'] using hr') apply Subtype.ext exact centered_model_determines_set (by simpa only [hdST, hpST] using hmodel S) (hmodel T) · let B : Finset A := Finset.univ.filter (fun S => g S = none) have hmaps : Set.MapsTo d (B : Set A) (Finset.Icc 1 N : Set ℕ) := by intro S hS exact Finset.mem_Icc.mpr ⟨hd S, hdN S⟩ have hfiber : ∀ k ∈ Finset.Icc 1 N, (B.filter (fun S => d S = k)).card ≤ 20000 := by intro k hk let C := B.filter (fun S => d S = k) have hpinj : Set.InjOn p (C : Set A) := by intro S hS T hT hpST have hdSk : d S = k := (Finset.mem_filter.mp hS).2 have hdTk : d T = k := (Finset.mem_filter.mp hT).2 apply Subtype.ext exact centered_model_determines_set (by simpa only [hdSk] using hmodel S) (by simpa only [hdTk, ← hpST] using hmodel T) have hfilter : (C.image p).filter (fun q => f q = none) = C.image p := by apply Finset.filter_eq_self.mpr intro q hq obtain ⟨S, hS, rfl⟩ := Finset.mem_image.mp hq have hSB : S ∈ B := (Finset.mem_filter.mp hS).1 have hnone : g S = none := (Finset.mem_filter.mp hSB).2 exact Option.map_eq_none_iff.mp hnone have hh := hexcept (C.image p) rw [hfilter, Finset.card_image_of_injOn hpinj] at hh exact hh change B.card ≤ 20000 * N rw [Finset.card_eq_sum_card_fiberwise hmaps] calc _ ≤ ∑ k ∈ Finset.Icc 1 N, 20000 := Finset.sum_le_sum hfiber _ = 20000 * N := by simp [Nat.mul_comm] end /- ModularMatching -/ /- Matching a rooted family into pairs leaving the root's residue class. -/ section open Finset def outsideRootResidue (N c k : ℕ) : Finset ℕ := (Finset.Icc 1 N).filter (fun x => ¬ Nat.ModEq k c x) theorem centered_model_step_dvd_offset {c d x : ℕ} {p : ProgressionCell} {S : Finset ℕ} (hmodel : IsCenteredModel c d p S) (hx : x ∈ S) : (d : ℤ) ∣ (x : ℤ) - c := by have hxI : (x : ℤ) ∈ S.image (fun y : ℕ => (y : ℤ)) := Finset.mem_image.mpr ⟨x, hx, rfl⟩ rw [hmodel] at hxI obtain ⟨z, _hz, heq⟩ := Finset.mem_image.mp hxI exact ⟨z, by linarith only [heq]⟩ theorem natural_matched_pair_meets_residue_complement {N c d k : ℕ} {p : ProgressionCell} {S : Finset ℕ} {q : ℕ × ℕ} (hsub : S ⊆ Finset.Icc 1 N) (hmodel : IsCenteredModel c d p S) (hq : NaturalMatchedPair c d S q) (hmet : (S ∩ outsideRootResidue N c k).Nonempty) : ¬ Disjoint ({q.1, q.2} : Finset ℕ) (outsideRootResidue N c k) := by intro hdis have hxmod : Nat.ModEq k c q.1 := by by_contra hh exact Finset.disjoint_left.mp hdis (by simp) (Finset.mem_filter.mpr ⟨hsub hq.1, hh⟩) have hymod : Nat.ModEq k c q.2 := by by_contra hh exact Finset.disjoint_left.mp hdis (by simp) (Finset.mem_filter.mpr ⟨hsub hq.2.1, hh⟩) have hkd : k ∣ d := by rw [← hq.2.2.2.2.2.1] exact Int.dvd_gcd hxmod.dvd hymod.dvd obtain ⟨x, hx⟩ := hmet obtain ⟨hxS, hxP⟩ := Finset.mem_inter.mp hx apply (Finset.mem_filter.mp hxP).2 exact Nat.modEq_of_dvd ((Int.natCast_dvd_natCast.mpr hkd).trans (centered_model_step_dvd_offset hmodel hxS)) theorem rooted_residue_good_large_card_le {N c k : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hcard : ∀ S ∈ F, 3 ≤ S.card) (hmet : ∀ S ∈ F, (S ∩ outsideRootResidue N c k).Nonempty) (hgood : ∀ S ∈ F, IsCrooked S → ∃ Q, IsWitnessPair S c Q ∧ ¬ Disjoint Q (outsideRootResidue N c k)) : F.card ≤ (meetingPairPool N c (outsideRootResidue N c k)).card + 20000*N := by classical have hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N := fun S hS => Finset.mem_powerset.mp (hF.1 hS) have htriple : ∀ S ∈ F, S.card = 3 → ¬ Disjoint (S.erase c) (outsideRootResidue N c k) := by intro S hS _hcard hdis obtain ⟨x, hx⟩ := hmet S hS obtain ⟨hxS, hxP⟩ := Finset.mem_inter.mp hx have hxc : x ≠ c := by intro heq apply (Finset.mem_filter.mp hxP).2 subst x rfl exact Finset.disjoint_left.mp hdis (Finset.mem_erase.mpr ⟨hxc, hxS⟩) hxP have hmatch : ∀ G : Finset (Finset ℕ), G ⊆ F → (∀ S ∈ G, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) → (∀ S ∈ G, 4 ≤ S.card) → ∃ g : {S // S ∈ G} → Option (ℕ × ℕ), (∀ S q, g S = some q → ∃ d : ℕ, 0 < d ∧ d ≤ N ∧ NaturalMatchedPair c d S.val q ∧ ¬ Disjoint ({q.1, q.2} : Finset ℕ) (outsideRootResidue N c k)) ∧ (∀ S T q, g S = some q → g T = some q → S = T) ∧ (Finset.univ.filter (fun S => g S = none)).card ≤ 20000*N := by intro G hGF hAP hsize obtain ⟨g, hg, hinj, hmiss⟩ := exists_natural_progression_pair_matching_with_models (fun S hS => hsub S (hGF hS)) hAP hsize (fun S hS => hc S (hGF hS)) refine ⟨g, ?_, hinj, hmiss⟩ intro S q hq obtain ⟨d, hd, hdN, hnat, p, hmodel⟩ := hg S q hq exact ⟨d, hd, hdN, hnat, natural_matched_pair_meets_residue_complement (hsub S.val (hGF S.property)) hmodel hnat (hmet S.val (hGF S.property))⟩ obtain ⟨f, hvalid, hallowed, hinj, hmiss⟩ := exists_common_point_pair_matching_allowed hF hc hcard hgood htriple hmatch have hm := partial_matching_card_le (B := meetingPairPool N c (outsideRootResidue N c k)) f (fun S Q hQ => Finset.mem_filter.mpr ⟨Finset.mem_powersetCard.mpr ⟨?_, (hvalid S Q hQ).1⟩, hallowed S Q hQ⟩) hinj hmiss · simpa only [Fintype.card_coe] using hm · intro x hx obtain ⟨hxc, hxS⟩ := Finset.mem_erase.mp ((hvalid S Q hQ).2 hx) exact Finset.mem_erase.mpr ⟨hxc, hsub S.val S.property hxS⟩ theorem rooted_residue_card_le {N c k : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hmet : ∀ S ∈ F, (S ∩ outsideRootResidue N c k).Nonempty) : F.card ≤ (meetingPairPool N c (outsideRootResidue N c k)).card + 20001*N + witnessExceptionBound N c := by classical let P := outsideRootResidue N c k let Bad (S : Finset ℕ) := IsCrooked S ∧ ∀ Q, IsWitnessPair S c Q → Disjoint Q P let B := F.filter Bad let G := F.filter (fun S => ¬Bad S) have hBF : B ⊆ F := Finset.filter_subset _ _ have hGF : G ⊆ F := Finset.filter_subset _ _ have hB : B.card ≤ witnessExceptionBound N c := by apply restricted_witness_bad_family_card_le (arithInterSet_mono hF hBF) (fun S hS => hc S (hBF hS)) (fun S hS => (Finset.mem_filter.mp hS).2.1) · intro S hS obtain ⟨x, hx⟩ := hmet S (hBF hS) obtain ⟨hxS, hxP⟩ := Finset.mem_inter.mp hx have hxc : x ≠ c := by intro heq apply (Finset.mem_filter.mp hxP).2 subst x rfl exact ⟨x, Finset.mem_inter.mpr ⟨Finset.mem_erase.mpr ⟨hxc, hxS⟩, hxP⟩⟩ · intro S hS exact (Finset.mem_filter.mp hS).2.2 let T := G.filter (fun S => S.card ≤ 2) let H := G.filter (fun S => ¬S.card ≤ 2) have hTG : T ⊆ G := Finset.filter_subset _ _ have hHG : H ⊆ G := Finset.filter_subset _ _ have hT : T.card ≤ N := by have hh := small_common_point_card_le (F := T) (U := Finset.Icc 1 N) (c := c) (fun S hS => Finset.mem_powerset.mp (hF.1 (hGF (hTG hS)))) (fun S hS => hc S (hGF (hTG hS))) (fun S hS => (Finset.mem_filter.mp hS).2) simpa using hh have hH : H.card ≤ (meetingPairPool N c P).card + 20000*N := by apply rooted_residue_good_large_card_le (arithInterSet_mono hF (hHG.trans hGF)) (fun S hS => hc S (hGF (hHG hS))) · intro S hS have hh := (Finset.mem_filter.mp hS).2 omega · intro S hS exact hmet S (hGF (hHG hS)) · intro S hS hcrooked by_contra hbad apply (Finset.mem_filter.mp (hHG hS)).2 refine ⟨hcrooked, ?_⟩ intro Q hQ by_contra hn exact hbad ⟨Q, hQ, hn⟩ have hpart := Finset.card_filter_add_card_filter_not (s := F) Bad have hpartG := Finset.card_filter_add_card_filter_not (s := G) (fun S => S.card ≤ 2) change B.card + G.card = F.card at hpart change T.card + H.card = G.card at hpartG change F.card ≤ (meetingPairPool N c P).card + 20001*N + witnessExceptionBound N c omega end /- ResidueCounting -/ /- Finite counts for a parity-restricted rooted family and a fixed-step family. -/ section open Finset theorem outsideRootResidue_two_card_le (N c : ℕ) : 2*(outsideRootResidue N c 2).card ≤ N+1 := by have hmaps : Set.MapsTo (fun x : ℕ => (x-1)/2) (outsideRootResidue N c 2 : Set ℕ) (Finset.range ((N+1)/2) : Set ℕ) := by intro x hx obtain ⟨hxI, _hxmod⟩ := Finset.mem_filter.mp hx obtain ⟨hx1, hxN⟩ := Finset.mem_Icc.mp hxI apply Finset.mem_range.mpr change (x-1)/2 < (N+1)/2 omega have hinj : Set.InjOn (fun x : ℕ => (x-1)/2) (outsideRootResidue N c 2 : Set ℕ) := by intro x hx y hy heq obtain ⟨hxI, hxmod⟩ := Finset.mem_filter.mp hx obtain ⟨hyI, hymod⟩ := Finset.mem_filter.mp hy obtain ⟨hx1, hxN⟩ := Finset.mem_Icc.mp hxI obtain ⟨hy1, hyN⟩ := Finset.mem_Icc.mp hyI change ¬c%2 = x%2 at hxmod change ¬c%2 = y%2 at hymod change (x-1)/2 = (y-1)/2 at heq omega have hh := Finset.card_le_card_of_injOn _ hmaps hinj simp only [Finset.card_range] at hh omega theorem parity_meeting_pair_pool_card_le {N c : ℕ} (hN : 1 ≤ N) : ((meetingPairPool N c (outsideRootResidue N c 2)).card : ℝ) ≤ 3*(N : ℝ)^2/8 + N + 1 := by have hP : outsideRootResidue N c 2 ⊆ Finset.Icc 1 N := Finset.filter_subset _ _ have hcP : c ∉ outsideRootResidue N c 2 := by intro hc exact (Finset.mem_filter.mp hc).2 rfl have hcount := meetingPairPool_card_real hP hcP have hPcount : 2*((outsideRootResidue N c 2).card : ℝ) ≤ (N : ℝ)+1 := by exact_mod_cast outsideRootResidue_two_card_le N c have hNR : (1 : ℝ) ≤ N := by exact_mod_cast hN have hprod := mul_nonneg (show 0 ≤ (N : ℝ)+1-2*(outsideRootResidue N c 2).card by linarith only [hPcount]) (show 0 ≤ 3*(N : ℝ)-1-2*(outsideRootResidue N c 2).card by linarith only [hPcount, hNR]) nlinarith only [hcount, hprod, hNR] theorem rooted_parity_card_le {N c : ℕ} {F : Finset (Finset ℕ)} (hcI : c ∈ Finset.Icc 1 N) (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, c ∈ S) (hmet : ∀ S ∈ F, (S ∩ outsideRootResidue N c 2).Nonempty) : (F.card : ℝ) ≤ 3*(N : ℝ)^2/8 + 20002*N + 1 + 48*N*((Nat.log 2 N + 1 : ℕ) : ℝ)^3 := by have hNat := rooted_residue_card_le hF hc hmet have hcount : (F.card : ℝ) ≤ (meetingPairPool N c (outsideRootResidue N c 2)).card + 20001*(N : ℝ) + witnessExceptionBound N c := by exact_mod_cast hNat have hN : 1 ≤ N := by have hh := Finset.mem_Icc.mp hcI; omega have hpairs := parity_meeting_pair_pool_card_le (c := c) hN have herr : (witnessExceptionBound N c : ℝ) ≤ 48*(N : ℝ)*((Nat.log 2 N + 1 : ℕ) : ℝ)^3 := by exact_mod_cast witnessExceptionBound_le_natLog hcI linarith only [hcount, hpairs, herr] theorem natAP_mem_of_bounds_modEq {a d m x : ℕ} (hd : 0 < d) (hm : 0 < m) (hax : a ≤ x) (hxm : x ≤ a+(m-1)*d) (hmod : Nat.ModEq d a x) : x ∈ natAP a d m := by have hdiv : d ∣ x-a := (Nat.modEq_iff_dvd' hax).mp hmod let i := (x-a)/d have hid : i*d = x-a := Nat.div_mul_cancel hdiv have hrep : a+i*d = x := by omega have himul : i*d < m*d := by have hmsub : m-1+1 = m := by omega nlinarith only [hrep, hxm, hd, hmsub] have hi : i < m := Nat.lt_of_mul_lt_mul_right himul exact mem_natAP.mpr ⟨i, hi, hrep⟩ theorem natAP_avoiding_internal_root_subset_residue_complement {N c a d m : ℕ} (hd : 0 < d) (hm : 0 < m) (hsub : natAP a d m ⊆ Finset.Icc 1 N) (hac : a ≤ c) (hctop : c ≤ a+(m-1)*d) (hc : c ∉ natAP a d m) : natAP a d m ⊆ outsideRootResidue N c d := by intro x hx refine Finset.mem_filter.mpr ⟨hsub hx, ?_⟩ intro hcx have hax : Nat.ModEq d a x := by obtain ⟨i, _hi, rfl⟩ := mem_natAP.mp hx change a%d = (a+i*d)%d simp only [Nat.add_mul_mod_self_right] have hacmod : Nat.ModEq d a c := hax.trans hcx.symm exact hc (natAP_mem_of_bounds_modEq hd hm hac hctop hacmod) theorem same_step_family_full_card_le {N d : ℕ} {F : Finset (Finset ℕ)} (hd : 0 < d) (hF : Erdos272.IsArithInterSet N F) (hrep : ∀ S ∈ F, ∃ a : ℕ, S = natAP a d S.card) : (F.card : ℝ) ≤ (N : ℝ)^2/(4*(d : ℝ)^2) + (N : ℝ)/d + 18*N + 4 := by classical let A := F.filter (fun S => 4 ≤ S.card) let B := F.filter (fun S => ¬4 ≤ S.card) have hA : (A.card : ℝ) ≤ (N : ℝ)^2/(4*(d : ℝ)^2) + (N : ℝ)/d + 1 := by apply same_step_family_card_le hd (admissible_subfamily hF (Finset.filter_subset _ _)) · intro S hS exact (Finset.mem_filter.mp hS).2 · intro S hS exact hrep S (Finset.mem_filter.mp hS).1 have hB : B.card ≤ 18*N+3 := by apply progression_family_small_card_le (admissible_subfamily hF (Finset.filter_subset _ _)) · intro S hS obtain ⟨a, heq⟩ := hrep S (Finset.mem_filter.mp hS).1 rw [heq] exact ⟨S.card, natAP_isAP hd⟩ · intro S hS have hh := (Finset.mem_filter.mp hS).2 omega have hBR : (B.card : ℝ) ≤ 18*(N : ℝ)+3 := by exact_mod_cast hB have hpart : (A.card : ℝ)+(B.card : ℝ) = F.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := F) (fun S => 4 ≤ S.card) linarith only [hA, hBR, hpart] end /- TwoStepStraddling -/ /- A quadratic gap when the progressions avoiding the root have step two. -/ section open Finset Filter def StraddlesRoot (c : ℕ) (S : Finset ℕ) : Prop := (∃ x ∈ S, x < c) ∧ ∃ y ∈ S, c < y theorem natAP_bounds_of_mem {a d m x : ℕ} (hx : x ∈ natAP a d m) : a ≤ x ∧ x ≤ a+(m-1)*d := by obtain ⟨i, hi, rfl⟩ := mem_natAP.mp hx have hii : i ≤ m-1 := by omega have hmul := Nat.mul_le_mul_right d hii omega theorem straddling_natAP_subset_residue_complement {N c a d : ℕ} {S : Finset ℕ} (hd : 0 < d) (hrep : S = natAP a d S.card) (hsub : S ⊆ Finset.Icc 1 N) (hstraddle : StraddlesRoot c S) (hc : c ∉ S) : S ⊆ outsideRootResidue N c d := by obtain ⟨⟨x, hx, hxc⟩, y, hy, hcy⟩ := hstraddle have hm : 0 < S.card := Finset.card_pos.mpr ⟨x, hx⟩ have hleft := (natAP_bounds_of_mem (hrep ▸ hx)).1 have hright := (natAP_bounds_of_mem (hrep ▸ hy)).2 have hh := natAP_avoiding_internal_root_subset_residue_complement hd hm (by simpa only [← hrep] using hsub) (by omega : a ≤ c) (by omega : c ≤ a+(S.card-1)*d) (by simpa only [← hrep] using hc) simpa only [← hrep] using hh theorem two_step_straddling_family_card_le {N c : ℕ} {F : Finset (Finset ℕ)} (hcI : c ∈ Finset.Icc 1 N) (hF : Erdos272.IsArithInterSet N F) (hrep : ∀ S ∈ F, c ∉ S → ∃ a, S = natAP a 2 S.card) (houtside : ∃ P ∈ F, c ∉ P ∧ StraddlesRoot c P) : (F.card : ℝ) ≤ 7*(N : ℝ)^2/16 + 20021*N + 5 + 48*N*((Nat.log 2 N+1 : ℕ) : ℝ)^3 := by classical obtain ⟨P, hPF, hcP, hstraddle⟩ := houtside obtain ⟨a, hPa⟩ := hrep P hPF hcP have hPsub : P ⊆ outsideRootResidue N c 2 := straddling_natAP_subset_residue_complement (by decide) hPa (Finset.mem_powerset.mp (hF.1 hPF)) hstraddle hcP have hPne : P.Nonempty := by obtain ⟨x, hx, _hxc⟩ := hstraddle.1; exact ⟨x, hx⟩ let R := F.filter (fun S => c ∈ S) let O := F.filter (fun S => c ∉ S) have hR : (R.card : ℝ) ≤ 3*(N : ℝ)^2/8 + 20002*N + 1 + 48*N*((Nat.log 2 N+1 : ℕ) : ℝ)^3 := by apply rooted_parity_card_le hcI (admissible_subfamily hF (Finset.filter_subset _ _)) (fun S hS => (Finset.mem_filter.mp hS).2) intro S hS obtain ⟨x, hx⟩ := arithInter_inter_nonempty hF hPF (Finset.mem_filter.mp hS).1 hPne obtain ⟨hxP, hxS⟩ := Finset.mem_inter.mp hx exact ⟨x, Finset.mem_inter.mpr ⟨hxS, hPsub hxP⟩⟩ have hO : (O.card : ℝ) ≤ (N : ℝ)^2/16 + (N : ℝ)/2 + 18*N + 4 := by have hh := same_step_family_full_card_le (by decide : 0 < 2) (admissible_subfamily hF (show O ⊆ F from Finset.filter_subset _ _)) (fun S hS => hrep S (Finset.mem_filter.mp hS).1 (Finset.mem_filter.mp hS).2) norm_num only [Nat.cast_ofNat, show (4 : ℝ)*2^2 = 16 by norm_num] at hh exact hh have hpart : (R.card : ℝ)+(O.card : ℝ) = F.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := F) (fun S => c ∈ S) nlinarith only [hR, hO, hpart, Nat.cast_nonneg (α := ℝ) N] theorem eventually_const_mul_natLog_pow_le (C k : ℕ) : ∀ᶠ N : ℕ in atTop, C*(Nat.log 2 N+1)^k ≤ N := by filter_upwards [eventually_natLog_pow_le (2*k), Filter.eventually_ge_atTop (C^2)] with N hlog hN have hsq : (C*(Nat.log 2 N+1)^k)^2 ≤ N^2 := by calc (C*(Nat.log 2 N+1)^k)^2 = C^2*(Nat.log 2 N+1)^(2*k) := by ring _ ≤ C^2*N := Nat.mul_le_mul_left _ hlog _ ≤ N*N := Nat.mul_le_mul_right _ hN _ = N^2 := by ring exact (Nat.pow_le_pow_iff_left (by decide : 2 ≠ 0)).mp hsq theorem eventually_two_step_straddling_gap : ∀ᶠ N : ℕ in atTop, ∀ (F : Finset (Finset ℕ)) (c : ℕ), c ∈ Finset.Icc 1 N → Erdos272.IsArithInterSet N F → (∀ S ∈ F, c ∉ S → ∃ a, S = natAP a 2 S.card) → (∃ P ∈ F, c ∉ P ∧ StraddlesRoot c P) → (F.card : ℝ) ≤ 15*(N : ℝ)^2/32 := by filter_upwards [eventually_const_mul_natLog_pow_le 3072 3, Filter.eventually_ge_atTop 2000000] with N hlog hN F c hcI hF hrep houtside have hbound := two_step_straddling_family_card_le hcI hF hrep houtside have hlogR : 3072*((Nat.log 2 N+1 : ℕ) : ℝ)^3 ≤ (N : ℝ) := by exact_mod_cast hlog have hNR : (2000000 : ℝ) ≤ N := by exact_mod_cast hN have hlogmul := mul_le_mul_of_nonneg_right hlogR (Nat.cast_nonneg N : (0 : ℝ) ≤ N) have hNmul := mul_le_mul_of_nonneg_right hNR (Nat.cast_nonneg N : (0 : ℝ) ≤ N) nlinarith only [hbound, hlogmul, hNmul, hNR] end /- OutsidePairCount -/ /- Counting meeting pairs with at least one endpoint outside an inner set. -/ section open Finset def meetingOutsidePairs {α : Type*} [DecidableEq α] (U B P : Finset α) : Finset (Finset α) := (U.powersetCard 2).filter (fun Q => ¬Disjoint Q P ∧ ¬Q ⊆ B) theorem meetingOutsidePairs_card_add {α : Type*} [DecidableEq α] {U B : Finset α} (hBU : B ⊆ U) (P : Finset α) : (meetingOutsidePairs U B P).card + ((B.powersetCard 2).filter (fun Q => ¬Disjoint Q (P ∩ B))).card = ((U.powersetCard 2).filter (fun Q => ¬Disjoint Q P)).card := by classical let M := (U.powersetCard 2).filter (fun Q => ¬Disjoint Q P) have hinside : M.filter (fun Q => Q ⊆ B) = (B.powersetCard 2).filter (fun Q => ¬Disjoint Q (P ∩ B)) := by ext Q constructor · intro hQ obtain ⟨hQM, hQB⟩ := Finset.mem_filter.mp hQ obtain ⟨hQU, hQP⟩ := Finset.mem_filter.mp hQM refine Finset.mem_filter.mpr ⟨Finset.mem_powersetCard.mpr ⟨hQB, (Finset.mem_powersetCard.mp hQU).2⟩, ?_⟩ intro hdis apply hQP exact Finset.disjoint_left.mpr (fun x hxQ hxP => Finset.disjoint_left.mp hdis hxQ (Finset.mem_inter.mpr ⟨hxP, hQB hxQ⟩)) · intro hQ obtain ⟨hQB, hQP⟩ := Finset.mem_filter.mp hQ obtain ⟨hsub, hcard⟩ := Finset.mem_powersetCard.mp hQB refine Finset.mem_filter.mpr ⟨Finset.mem_filter.mpr ⟨Finset.mem_powersetCard.mpr ⟨hsub.trans hBU, hcard⟩, ?_⟩, hsub⟩ intro hdis apply hQP exact Finset.disjoint_left.mpr (fun x hxQ hxPB => Finset.disjoint_left.mp hdis hxQ (Finset.mem_inter.mp hxPB).1) have houtside : M.filter (fun Q => ¬Q ⊆ B) = meetingOutsidePairs U B P := by simp only [M, meetingOutsidePairs, Finset.filter_filter] have hh := Finset.card_filter_add_card_filter_not (s := M) (fun Q => Q ⊆ B) rw [hinside, houtside] at hh dsimp only [M] at hh omega theorem meetingOutsidePairs_card_real {α : Type*} [DecidableEq α] {U B P : Finset α} (hBU : B ⊆ U) (hPU : P ⊆ U) : ((meetingOutsidePairs U B P).card : ℝ) = ((P \ B).card : ℝ)*U.card - ((P \ B).card : ℝ)^2/2 - ((P \ B).card : ℝ)/2 + ((P ∩ B).card : ℝ)*((U \ B).card - ((P \ B).card : ℝ)) := by have hsum : ((meetingOutsidePairs U B P).card : ℝ) + (((B.powersetCard 2).filter (fun Q => ¬Disjoint Q (P ∩ B))).card : ℝ) = (((U.powersetCard 2).filter (fun Q => ¬Disjoint Q P)).card : ℝ) := by exact_mod_cast meetingOutsidePairs_card_add hBU P rw [card_meeting_pairs_real hPU, card_meeting_pairs_real Finset.inter_subset_right] at hsum have hPpart : (P.card : ℝ) = ((P \ B).card : ℝ) + (P ∩ B).card := by exact_mod_cast (Finset.card_sdiff_add_card_inter P B).symm have hBpart : (U.card : ℝ) = ((U \ B).card : ℝ) + B.card := by exact_mod_cast (Finset.card_sdiff_add_card_eq_card hBU).symm rw [hPpart, hBpart] at hsum rw [hBpart] nlinarith only [hsum] theorem meetingOutsidePairs_card_le {α : Type*} [DecidableEq α] {U B P : Finset α} (hBU : B ⊆ U) (hPU : P ⊆ U) : ((meetingOutsidePairs U B P).card : ℝ) ≤ ((P \ B).card : ℝ)*U.card - ((P \ B).card : ℝ)^2/2 + ((P ∩ B).card : ℝ)*((U \ B).card - ((P \ B).card : ℝ)) := by rw [meetingOutsidePairs_card_real hBU hPU] linarith only [Nat.cast_nonneg (α := ℝ) (P \ B).card] def crossPairPool {α : Type*} [DecidableEq α] (L R : Finset α) : Finset (Finset α) := (L.product R).image (fun p => {p.1, p.2}) theorem crossPairPool_card_le {α : Type*} [DecidableEq α] (L R : Finset α) : (crossPairPool L R).card ≤ L.card*R.card := by exact (Finset.card_image_le).trans_eq (Finset.card_product L R) end /- IntervalWitnessPool -/ /- Rooted interval endpoints and intrinsic witnesses share a controlled pair pool. -/ section open Finset theorem witness_pair_not_subset_AP_member {N c : ℕ} {F : Finset (Finset ℕ)} {S T Q : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hS : S ∈ F) (hT : T ∈ F) (hcS : c ∈ S) (hcT : c ∈ T) (hcrooked : IsCrooked S) (hAP : ∃ l : ℕ∞, (T : Set ℕ).IsAPOfLength l) (hQ : IsWitnessPair S c Q) : ¬Q ⊆ T := by intro hQT have hTS := witness_pair_private hF hS hT hcS hcT hQ hQT exact hcrooked (by simpa only [hTS] using hAP) theorem root_pair_in_cross_of_inner {c u v : ℕ} {Q : Finset ℕ} (hcard : Q.card = 2) (hc : c ∉ Q) (hinner : Q ⊆ Finset.Icc u v) (hleft : ¬Q ⊆ Finset.Icc u c) (hright : ¬Q ⊆ Finset.Icc c v) : Q ∈ crossPairPool (Finset.Ico u c) (Finset.Ioc c v) := by obtain ⟨x, y, _hxy, rfl⟩ := Finset.card_eq_two.mp hcard have hx := Finset.mem_Icc.mp (hinner (by simp : x ∈ ({x, y} : Finset ℕ))) have hy := Finset.mem_Icc.mp (hinner (by simp : y ∈ ({x, y} : Finset ℕ))) have hxc : x ≠ c := by intro heq; apply hc; simp [heq] have hyc : y ≠ c := by intro heq; apply hc; simp [heq] by_cases hxlt : x < c · have hcy : c < y := by by_contra hn apply hleft intro z hz simp only [Finset.mem_insert, Finset.mem_singleton] at hz rcases hz with rfl | rfl <;> exact Finset.mem_Icc.mpr (by omega) exact Finset.mem_image.mpr ⟨(x,y), Finset.mem_product.mpr ⟨Finset.mem_Ico.mpr ⟨hx.1, hxlt⟩, Finset.mem_Ioc.mpr ⟨hcy, hy.2⟩⟩, rfl⟩ · have hylt : y < c := by by_contra hn apply hright intro z hz simp only [Finset.mem_insert, Finset.mem_singleton] at hz rcases hz with rfl | rfl <;> exact Finset.mem_Icc.mpr (by omega) exact Finset.mem_image.mpr ⟨(y,x), Finset.mem_product.mpr ⟨Finset.mem_Ico.mpr ⟨hy.1, hylt⟩, Finset.mem_Ioc.mpr ⟨by omega, hx.2⟩⟩, by simp only [Finset.pair_comm]⟩ theorem crooked_witness_in_interval_pool {N c u v : ℕ} {F : Finset (Finset ℕ)} {S Q P : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hS : S ∈ F) (huc : u ≤ c) (hcv : c ≤ v) (hcS : c ∈ S) (hcrooked : IsCrooked S) (hleft : u = c ∨ ∃ T ∈ F, (∃ l : ℕ∞, (T : Set ℕ).IsAPOfLength l) ∧ Finset.Icc u c ⊆ T) (hright : v = c ∨ ∃ T ∈ F, (∃ l : ℕ∞, (T : Set ℕ).IsAPOfLength l) ∧ Finset.Icc c v ⊆ T) (hQ : IsWitnessPair S c Q) (hmet : ¬Disjoint Q P) : Q ∈ crossPairPool (Finset.Ico u c) (Finset.Ioc c v) ∪ meetingOutsidePairs ((Finset.Icc 1 N).erase c) ((Finset.Icc u v).erase c) P := by have hcQ : c ∉ Q := by intro hc exact (Finset.mem_erase.mp (hQ.2.1 hc)).1 rfl have hnotleft : ¬Q ⊆ Finset.Icc u c := by intro hsub rcases hleft with heq | ⟨T, hT, hAP, hcover⟩ · have hh := Finset.card_le_card hsub simp only [heq, Finset.Icc_self, Finset.card_singleton, hQ.1] at hh omega exact witness_pair_not_subset_AP_member hF hS hT hcS (hcover (Finset.mem_Icc.mpr ⟨huc, le_rfl⟩)) hcrooked hAP hQ (hsub.trans hcover) have hnotright : ¬Q ⊆ Finset.Icc c v := by intro hsub rcases hright with heq | ⟨T, hT, hAP, hcover⟩ · have hh := Finset.card_le_card hsub simp only [heq, Finset.Icc_self, Finset.card_singleton, hQ.1] at hh omega exact witness_pair_not_subset_AP_member hF hS hT hcS (hcover (Finset.mem_Icc.mpr ⟨le_rfl, hcv⟩)) hcrooked hAP hQ (hsub.trans hcover) by_cases hinner : Q ⊆ Finset.Icc u v · exact Finset.mem_union_left _ (root_pair_in_cross_of_inner hQ.1 hcQ hinner hnotleft hnotright) · apply Finset.mem_union_right refine Finset.mem_filter.mpr ⟨Finset.mem_powersetCard.mpr ⟨?_, hQ.1⟩, hmet, fun hh => hinner (hh.trans (Finset.erase_subset _ _))⟩ intro x hx obtain ⟨hxc, hxS⟩ := Finset.mem_erase.mp (hQ.2.1 hx) exact Finset.mem_erase.mpr ⟨hxc, Finset.mem_powerset.mp (hF.1 hS) hxS⟩ theorem interval_isAP {a b : ℕ} (hab : a ≤ b) : ∃ l : ℕ∞, ((Finset.Icc a b : Finset ℕ) : Set ℕ).IsAPOfLength l := by simpa [apSegment] using apSegment_isAP hab (by decide : 0 < 1) theorem private_pairs_and_intervals_card_le {N c : ℕ} {F C E : Finset (Finset ℕ)} {Pool : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hCF : C ⊆ F) (hEF : E ⊆ F) (hc : ∀ S ∈ C, c ∈ S) (hcrooked : ∀ S ∈ C, IsCrooked S) (hW : ∀ S ∈ C, ∃ Q, IsWitnessPair S c Q ∧ Q ∈ Pool) (hE : ∀ S ∈ E, ∃ a b : ℕ, a < c ∧ c < b ∧ S = Finset.Icc a b ∧ ({a,b} : Finset ℕ) ∈ Pool) : C.card + E.card ≤ Pool.card := by classical let X := {S // S ∈ C} let Y := {S // S ∈ E} have hparamC : ∀ S : X, ∃ Q, IsWitnessPair S.val c Q ∧ Q ∈ Pool := fun S => hW S.val S.property choose Q hQ hQPool using hparamC have hparamE : ∀ T : Y, ∃ a b : ℕ, a < c ∧ c < b ∧ T.val = Finset.Icc a b ∧ ({a,b} : Finset ℕ) ∈ Pool := fun T => hE T.val T.property choose a b hac hcb hrep hPairPool using hparamE let e : Y → Finset ℕ := fun T => {a T, b T} have hQinj : Function.Injective Q := by intro S T heq apply Subtype.ext exact (witness_pair_private hF (hCF S.property) (hCF T.property) (hc S.val S.property) (hc T.val T.property) (hQ S) (by rw [heq] exact (hQ T).2.1.trans (Finset.erase_subset _ _))).symm have heinj : Function.Injective e := by intro S T heq have hST := sorted_pair_finset_injective (lt_trans (hac S) (hcb S)) (lt_trans (hac T) (hcb T)) heq have haST := congrArg Prod.fst hST have hbST := congrArg Prod.snd hST change a S = a T at haST change b S = b T at hbST apply Subtype.ext rw [hrep S, hrep T, haST, hbST] have hdis : Disjoint ((Finset.univ : Finset X).image Q) ((Finset.univ : Finset Y).image e) := by apply Finset.disjoint_left.mpr intro W hWC hWE obtain ⟨S, _hS, rfl⟩ := Finset.mem_image.mp hWC obtain ⟨T, _hT, hTeq⟩ := Finset.mem_image.mp hWE have hTab : a T ≤ b T := le_of_lt (lt_trans (hac T) (hcb T)) have hAP : ∃ l : ℕ∞, (T.val : Set ℕ).IsAPOfLength l := by rw [hrep T] exact interval_isAP hTab have hcT : c ∈ T.val := by rw [hrep T]; exact Finset.mem_Icc.mpr ⟨(hac T).le, (hcb T).le⟩ apply witness_pair_not_subset_AP_member hF (hCF S.property) (hEF T.property) (hc S.val S.property) hcT (hcrooked S.val S.property) hAP (hQ S) rw [← hTeq, hrep T] intro x hx simp only [e, Finset.mem_insert, Finset.mem_singleton] at hx rcases hx with rfl | rfl · exact Finset.mem_Icc.mpr ⟨le_rfl, hTab⟩ · exact Finset.mem_Icc.mpr ⟨hTab, le_rfl⟩ have hsub : ((Finset.univ : Finset X).image Q) ∪ ((Finset.univ : Finset Y).image e) ⊆ Pool := by intro W hW rcases Finset.mem_union.mp hW with hWC | hWE · obtain ⟨S, _hS, rfl⟩ := Finset.mem_image.mp hWC exact hQPool S · obtain ⟨T, _hT, rfl⟩ := Finset.mem_image.mp hWE exact hPairPool T have hh := Finset.card_le_card hsub rw [Finset.card_union_of_disjoint hdis, Finset.card_image_of_injective _ hQinj, Finset.card_image_of_injective _ heinj] at hh simpa only [Finset.card_univ, X, Y, Fintype.card_coe] using hh end /- StraddlingAlgebra -/ /- The finite quadratic optimization in the straddling case with step at least three. -/ section theorem large_step_straddling_polynomial {n l w h j : ℝ} (hn : 6 ≤ n) (hl : 0 ≤ l) (hw : 0 ≤ w) (hlen : l+w ≤ n) (hhw : h ≤ w) (hh : 3*h ≤ w+6) (hj : 3*j ≤ l+6) : l^2/4 + h*n - h^2/2 + j*(w-h) ≤ 5*n^2/18 + 3*n := by let A := w/3+2 let B := l/3+2 have hA : h ≤ A := by dsimp [A]; linarith only [hh] have hB : j ≤ B := by dsimp [B]; linarith only [hj] have hAB : A+B ≤ n := by dsimp [A, B]; linarith only [hlen, hn] have hfirst := mul_le_mul_of_nonneg_right hB (sub_nonneg.mpr hhw) have hsecond := mul_nonneg (sub_nonneg.mpr hA) (show 0 ≤ n-B-(h+A)/2 by linarith only [hA, hAB]) have hcount : l^2/4 + h*n-h^2/2+j*(w-h) ≤ l^2/4+A*n-A^2/2+B*(w-A) := by nlinarith only [hfirst, hsecond] have hprod := mul_nonneg (show 0 ≤ n-l-w by linarith only [hlen]) (show 0 ≤ 5*n+5*l-w by linarith only [hlen, hl, hw]) have hmain : l^2/4+w*n/3-w^2/18+2*l*w/9 ≤ 5*n^2/18 := by nlinarith only [hprod, sq_nonneg l] dsimp only [A, B] at hcount nlinarith only [hcount, hmain, hlen, hl, hn] end /- ResidueSpacing -/ /- Spacing estimates for a residue class in one interval and its two exterior intervals. -/ section open Finset theorem spaced_residue_card_mul_le {a k u v : ℕ} {S : Finset ℕ} (hk : 3 ≤ k) (hsub : S ⊆ Finset.Icc u v) (hmod : ∀ x ∈ S, Nat.ModEq k a x) : 3*S.card ≤ (Finset.Icc u v).card+3 := by by_cases huv : u ≤ v · have hmaps : Set.MapsTo (fun x : ℕ => (x-u)/3) (S : Set ℕ) (Finset.range ((v-u)/3+1) : Set ℕ) := by intro x hx obtain ⟨hux, hxv⟩ := Finset.mem_Icc.mp (hsub hx) apply Finset.mem_range.mpr change (x-u)/3 < (v-u)/3+1 omega have hinj : Set.InjOn (fun x : ℕ => (x-u)/3) (S : Set ℕ) := by intro x hx y hy heq obtain ⟨hux, hxv⟩ := Finset.mem_Icc.mp (hsub hx) obtain ⟨huy, hyv⟩ := Finset.mem_Icc.mp (hsub hy) change (x-u)/3 = (y-u)/3 at heq have hxy : Nat.ModEq k x y := (hmod x hx).symm.trans (hmod y hy) by_cases hle : x ≤ y · have hd : k ∣ y-x := (Nat.modEq_iff_dvd' hle).mp hxy have hlt : y-x < k := by omega have hz := Nat.eq_zero_of_dvd_of_lt hd hlt omega · have hd : k ∣ x-y := (Nat.modEq_iff_dvd' (by omega : y ≤ x)).mp hxy.symm have hlt : x-y < k := by omega have hz := Nat.eq_zero_of_dvd_of_lt hd hlt omega have hh := Finset.card_le_card_of_injOn _ hmaps hinj simp only [Finset.card_range] at hh rw [Nat.card_Icc] omega · have hS : S = ∅ := by apply Finset.not_nonempty_iff_eq_empty.mp rintro ⟨x, hx⟩ have hh := Finset.mem_Icc.mp (hsub hx) omega rw [hS] simp only [Finset.card_empty, Nat.mul_zero, Nat.zero_le] theorem straddling_residue_parts_card_le {N c a k u v : ℕ} {P : Finset ℕ} (hk : 3 ≤ k) (hu : 1 ≤ u) (huc : u ≤ c) (hcv : c ≤ v) (hvN : v ≤ N) (hP : P ⊆ Finset.Icc 1 N) (hcP : c ∉ P) (hmod : ∀ x ∈ P, Nat.ModEq k a x) : 3*(P \ (Finset.Icc u v).erase c).card ≤ ((Finset.Icc 1 N).erase c \ (Finset.Icc u v).erase c).card+6 ∧ 3*(P ∩ (Finset.Icc u v).erase c).card ≤ ((Finset.Icc u v).erase c).card+4 := by let U := (Finset.Icc 1 N).erase c let B := (Finset.Icc u v).erase c let O := P \ B let L := O.filter (fun x => x < u) let R := O.filter (fun x => ¬x < u) have hL : 3*L.card ≤ (Finset.Icc 1 (u-1)).card+3 := by apply spaced_residue_card_mul_le hk · intro x hx obtain ⟨hxO, hxu⟩ := Finset.mem_filter.mp hx have hxP := (Finset.mem_sdiff.mp hxO).1 have hxN := Finset.mem_Icc.mp (hP hxP) exact Finset.mem_Icc.mpr ⟨hxN.1, by omega⟩ · intro x hx exact hmod x (Finset.mem_sdiff.mp (Finset.mem_filter.mp hx).1).1 have hR : 3*R.card ≤ (Finset.Icc (v+1) N).card+3 := by apply spaced_residue_card_mul_le hk · intro x hx obtain ⟨hxO, hxu⟩ := Finset.mem_filter.mp hx obtain ⟨hxP, hxB⟩ := Finset.mem_sdiff.mp hxO have hxN := Finset.mem_Icc.mp (hP hxP) have hxc : x ≠ c := by intro heq; exact hcP (heq ▸ hxP) have hvx : v < x := by by_contra hn exact hxB (Finset.mem_erase.mpr ⟨hxc, Finset.mem_Icc.mpr ⟨by omega, by omega⟩⟩) exact Finset.mem_Icc.mpr ⟨by omega, hxN.2⟩ · intro x hx exact hmod x (Finset.mem_sdiff.mp (Finset.mem_filter.mp hx).1).1 have hJ : 3*(P ∩ B).card ≤ (Finset.Icc u v).card+3 := by apply spaced_residue_card_mul_le hk · intro x hx exact Finset.mem_of_mem_erase (Finset.mem_inter.mp hx).2 · intro x hx exact hmod x (Finset.mem_inter.mp hx).1 have hBU : B ⊆ U := by intro x hx obtain ⟨hxc, hxI⟩ := Finset.mem_erase.mp hx have hx := Finset.mem_Icc.mp hxI exact Finset.mem_erase.mpr ⟨hxc, Finset.mem_Icc.mpr ⟨by omega, by omega⟩⟩ have hcU : c ∈ Finset.Icc 1 N := Finset.mem_Icc.mpr ⟨by omega, by omega⟩ have hcB : c ∈ Finset.Icc u v := Finset.mem_Icc.mpr ⟨huc, hcv⟩ have hUcard : U.card = N-1 := by simp only [U, Finset.card_erase_of_mem hcU, Nat.card_Icc]; omega have hBcard : B.card = v-u := by simp only [B, Finset.card_erase_of_mem hcB, Nat.card_Icc]; omega have hOpart := Finset.card_filter_add_card_filter_not (s := O) (fun x => x < u) change L.card+R.card = O.card at hOpart have hUdiff := Finset.card_sdiff_add_card_eq_card hBU rw [hUcard, hBcard] at hUdiff simp only [Nat.card_Icc] at hL hR hJ change 3*O.card ≤ (U \ B).card+6 ∧ 3*(P ∩ B).card ≤ B.card+4 constructor <;> omega end /- IntervalPoolBound -/ /- The interval and witness pool has a uniform quadratic gap for spacing at least three. -/ section open Finset theorem interval_witness_pool_card_le {N c a k u v : ℕ} {P : Finset ℕ} (hN : 6 ≤ N) (hk : 3 ≤ k) (hu : 1 ≤ u) (huc : u ≤ c) (hcv : c ≤ v) (hvN : v ≤ N) (hP : P ⊆ Finset.Icc 1 N) (hcP : c ∉ P) (hmod : ∀ x ∈ P, Nat.ModEq k a x) : ((crossPairPool (Finset.Ico u c) (Finset.Ioc c v) ∪ meetingOutsidePairs ((Finset.Icc 1 N).erase c) ((Finset.Icc u v).erase c) P).card : ℝ) ≤ 5*(N : ℝ)^2/18+3*N := by let U := (Finset.Icc 1 N).erase c let B := (Finset.Icc u v).erase c let X := crossPairPool (Finset.Ico u c) (Finset.Ioc c v) let M := meetingOutsidePairs U B P have hBU : B ⊆ U := by intro x hx obtain ⟨hxc, hxI⟩ := Finset.mem_erase.mp hx have hh := Finset.mem_Icc.mp hxI exact Finset.mem_erase.mpr ⟨hxc, Finset.mem_Icc.mpr ⟨by omega, by omega⟩⟩ have hPU : P ⊆ U := by intro x hx exact Finset.mem_erase.mpr ⟨fun heq => hcP (heq ▸ hx), hP hx⟩ have hUcard : U.card ≤ N := by have hh := Finset.card_le_card (Finset.erase_subset (s := Finset.Icc 1 N) c) simpa only [Nat.card_Icc, Nat.add_sub_cancel] using hh have hcB : c ∈ Finset.Icc u v := Finset.mem_Icc.mpr ⟨huc, hcv⟩ have hBcard : B.card = v-u := by simp only [B, Finset.card_erase_of_mem hcB, Nat.card_Icc] omega have hLR : ((Finset.Ico u c).card : ℝ)+(Finset.Ioc c v).card = B.card := by exact_mod_cast (show (Finset.Ico u c).card+(Finset.Ioc c v).card = B.card by simp only [Nat.card_Ico, Nat.card_Ioc, hBcard] omega) have hXcard : (X.card : ℝ) ≤ (B.card : ℝ)^2/4 := by have hx : (X.card : ℝ) ≤ ((Finset.Ico u c).card : ℝ)*(Finset.Ioc c v).card := by exact_mod_cast crossPairPool_card_le (Finset.Ico u c) (Finset.Ioc c v) nlinarith only [hx, hLR, sq_nonneg (((Finset.Ico u c).card : ℝ)-(Finset.Ioc c v).card)] have hUcardR : (U.card : ℝ) ≤ N := by exact_mod_cast hUcard have hMN := mul_le_mul_of_nonneg_left hUcardR (Nat.cast_nonneg (P \ B).card : (0 : ℝ) ≤ (P \ B).card) have hMcard : (M.card : ℝ) ≤ ((P \ B).card : ℝ)*N - ((P \ B).card : ℝ)^2/2 + ((P ∩ B).card : ℝ)*((U \ B).card - ((P \ B).card : ℝ)) := by have hh := meetingOutsidePairs_card_le hBU hPU change (M.card : ℝ) ≤ _ at hh linarith only [hh, hMN] have hparts := straddling_residue_parts_card_le hk hu huc hcv hvN hP hcP hmod have hh : 3*((P \ B).card : ℝ) ≤ ((U \ B).card : ℝ)+6 := by exact_mod_cast hparts.1 have hj4 : 3*((P ∩ B).card : ℝ) ≤ (B.card : ℝ)+4 := by exact_mod_cast hparts.2 have hlen : (B.card : ℝ)+(U \ B).card ≤ (N : ℝ) := by have hh := Finset.card_sdiff_add_card_eq_card hBU have hnat : B.card+(U \ B).card ≤ N := by omega exact_mod_cast hnat have hhw : ((P \ B).card : ℝ) ≤ (U \ B).card := by exact_mod_cast Finset.card_le_card (show P \ B ⊆ U \ B by intro x hx obtain ⟨hxP, hxB⟩ := Finset.mem_sdiff.mp hx exact Finset.mem_sdiff.mpr ⟨hPU hxP, hxB⟩) have hpoly := large_step_straddling_polynomial (by exact_mod_cast hN) (Nat.cast_nonneg B.card) (Nat.cast_nonneg (U \ B).card) hlen hhw hh (show 3*((P ∩ B).card : ℝ) ≤ (B.card : ℝ)+6 by linarith only [hj4]) have hUnion : ((X ∪ M).card : ℝ) ≤ (X.card : ℝ)+(M.card : ℝ) := by exact_mod_cast Finset.card_union_le X M change ((X ∪ M).card : ℝ) ≤ _ linarith only [hUnion, hXcard, hMcard, hpoly] end /- IntervalEnvelope -/ /- Extremal endpoints and boundary members in a family of rooted intervals. -/ section open Finset theorem rooted_interval_envelope {N c : ℕ} {E : Finset (Finset ℕ)} (hcI : c ∈ Finset.Icc 1 N) (hsub : ∀ S ∈ E, S ⊆ Finset.Icc 1 N) (hc : ∀ S ∈ E, c ∈ S) (hinterval : ∀ S ∈ E, ∃ a b : ℕ, S = Finset.Icc a b) : ∃ u v : ℕ, 1 ≤ u ∧ u ≤ c ∧ c ≤ v ∧ v ≤ N ∧ (u = c ∨ ∃ T ∈ E, (∃ l : ℕ∞, (T : Set ℕ).IsAPOfLength l) ∧ Finset.Icc u c ⊆ T) ∧ (v = c ∨ ∃ T ∈ E, (∃ l : ℕ∞, (T : Set ℕ).IsAPOfLength l) ∧ Finset.Icc c v ⊆ T) ∧ ∀ S ∈ E, ∃ a b : ℕ, u ≤ a ∧ a ≤ c ∧ c ≤ b ∧ b ≤ v ∧ S = Finset.Icc a b := by classical by_cases hne : E.Nonempty · let X := {S // S ∈ E} have hparam : ∀ S : X, ∃ a b : ℕ, S.val = Finset.Icc a b := fun S => hinterval S.val S.property choose a b hrep using hparam have hab : ∀ S : X, a S ≤ c ∧ c ≤ b S := by intro S exact Finset.mem_Icc.mp (hrep S ▸ hc S.val S.property) have hbounds : ∀ S : X, 1 ≤ a S ∧ b S ≤ N := by intro S have hAS : a S ∈ S.val := by rw [hrep S]; exact Finset.mem_Icc.mpr ⟨le_rfl, (hab S).1.trans (hab S).2⟩ have hBS : b S ∈ S.val := by rw [hrep S]; exact Finset.mem_Icc.mpr ⟨(hab S).1.trans (hab S).2, le_rfl⟩ exact ⟨(Finset.mem_Icc.mp (hsub S.val S.property hAS)).1, (Finset.mem_Icc.mp (hsub S.val S.property hBS)).2⟩ have hX : (Finset.univ : Finset X).Nonempty := by obtain ⟨S, hS⟩ := hne exact ⟨⟨S, hS⟩, Finset.mem_univ _⟩ obtain ⟨L, _hL, hmin⟩ := Finset.exists_min_image Finset.univ a hX obtain ⟨R, _hR, hmax⟩ := Finset.exists_max_image Finset.univ b hX refine ⟨a L, b R, (hbounds L).1, (hab L).1, (hab R).2, (hbounds R).2, ?_, ?_, ?_⟩ · apply Or.inr refine ⟨L.val, L.property, ?_, ?_⟩ · rw [hrep L] exact interval_isAP ((hab L).1.trans (hab L).2) · intro x hx rw [hrep L] have hh := Finset.mem_Icc.mp hx exact Finset.mem_Icc.mpr ⟨hh.1, hh.2.trans (hab L).2⟩ · apply Or.inr refine ⟨R.val, R.property, ?_, ?_⟩ · rw [hrep R] exact interval_isAP ((hab R).1.trans (hab R).2) · intro x hx rw [hrep R] have hh := Finset.mem_Icc.mp hx exact Finset.mem_Icc.mpr ⟨(hab R).1.trans hh.1, hh.2⟩ · intro S hS let T : X := ⟨S, hS⟩ exact ⟨a T, b T, hmin T (Finset.mem_univ _), (hab T).1, (hab T).2, hmax T (Finset.mem_univ _), hrep T⟩ · refine ⟨c, c, (Finset.mem_Icc.mp hcI).1, le_rfl, le_rfl, (Finset.mem_Icc.mp hcI).2, Or.inl rfl, Or.inl rfl, ?_⟩ intro S hS exact False.elim (hne ⟨S, hS⟩) theorem rooted_boundary_intervals_card_le {N c : ℕ} {E : Finset (Finset ℕ)} (hsub : ∀ S ∈ E, S ⊆ Finset.Icc 1 N) (hc : ∀ S ∈ E, c ∈ S) (hinterval : ∀ S ∈ E, ∃ a b : ℕ, S = Finset.Icc a b) (hboundary : ∀ S ∈ E, ¬StraddlesRoot c S) : E.card ≤ 2*N := by let L := (Finset.Icc 1 N).image (fun a => Finset.Icc a c) let R := (Finset.Icc 1 N).image (fun b => Finset.Icc c b) have hcover : E ⊆ L ∪ R := by intro S hS obtain ⟨a, b, hrep⟩ := hinterval S hS have hcb := Finset.mem_Icc.mp (hrep ▸ hc S hS) have haS : a ∈ S := by rw [hrep]; exact Finset.mem_Icc.mpr ⟨le_rfl, hcb.1.trans hcb.2⟩ have hbS : b ∈ S := by rw [hrep]; exact Finset.mem_Icc.mpr ⟨hcb.1.trans hcb.2, le_rfl⟩ by_cases ha : a = c · apply Finset.mem_union_right exact Finset.mem_image.mpr ⟨b, hsub S hS hbS, by simpa only [ha] using hrep.symm⟩ · have hb : b = c := by by_contra hn exact hboundary S hS ⟨⟨a, haS, by omega⟩, b, hbS, by omega⟩ apply Finset.mem_union_left exact Finset.mem_image.mpr ⟨a, hsub S hS haS, by simpa only [hb] using hrep.symm⟩ have hL : L.card ≤ N := by have hh := Finset.card_image_le (s := Finset.Icc 1 N) (f := fun a => Finset.Icc a c) simpa only [Nat.card_Icc, Nat.add_sub_cancel] using hh have hR : R.card ≤ N := by have hh := Finset.card_image_le (s := Finset.Icc 1 N) (f := fun b => Finset.Icc c b) simpa only [Nat.card_Icc, Nat.add_sub_cancel] using hh have hh := (Finset.card_le_card hcover).trans (Finset.card_union_le L R) omega end /- LargeStepRooted -/ /- A joint bound for crooked members and rooted intervals meeting a sparse residue class. -/ section open Finset theorem crooked_and_intervals_meeting_sparse_residue_card_le {N c a k : ℕ} {F C E : Finset (Finset ℕ)} {P : Finset ℕ} (hN : 6 ≤ N) (hk : 3 ≤ k) (hcI : c ∈ Finset.Icc 1 N) (hF : Erdos272.IsArithInterSet N F) (hCF : C ⊆ F) (hEF : E ⊆ F) (hcC : ∀ S ∈ C, c ∈ S) (hC : ∀ S ∈ C, IsCrooked S) (hcE : ∀ S ∈ E, c ∈ S) (hE : ∀ S ∈ E, ∃ a b : ℕ, S = Finset.Icc a b) (hP : P ⊆ Finset.Icc 1 N) (hcP : c ∉ P) (hmod : ∀ x ∈ P, Nat.ModEq k a x) (hmet : ∀ S ∈ C, (S.erase c ∩ P).Nonempty) : (C.card : ℝ)+(E.card : ℝ) ≤ 5*(N : ℝ)^2/18+5*N+witnessExceptionBound N c := by classical let Good (S : Finset ℕ) := ∃ Q, IsWitnessPair S c Q ∧ ¬Disjoint Q P let G := C.filter Good let B := C.filter (fun S => ¬Good S) let D := E.filter (StraddlesRoot c) let J := E.filter (fun S => ¬StraddlesRoot c S) have hGC : G ⊆ C := Finset.filter_subset _ _ have hBC : B ⊆ C := Finset.filter_subset _ _ have hDE : D ⊆ E := Finset.filter_subset _ _ have hJE : J ⊆ E := Finset.filter_subset _ _ have hB : B.card ≤ witnessExceptionBound N c := by apply restricted_witness_bad_family_card_le (arithInterSet_mono hF (hBC.trans hCF)) (fun S hS => hcC S (hBC hS)) (fun S hS => hC S (hBC hS)) (fun S hS => hmet S (hBC hS)) intro S hS Q hQ by_contra hn exact (Finset.mem_filter.mp hS).2 ⟨Q, hQ, hn⟩ have hJ : J.card ≤ 2*N := rooted_boundary_intervals_card_le (fun S hS => Finset.mem_powerset.mp (hF.1 (hEF (hJE hS)))) (fun S hS => hcE S (hJE hS)) (fun S hS => hE S (hJE hS)) (fun S hS => (Finset.mem_filter.mp hS).2) obtain ⟨u, v, hu, huc, hcv, hvN, hleft, hright, henvelope⟩ := rooted_interval_envelope hcI (fun S hS => Finset.mem_powerset.mp (hF.1 (hEF hS))) hcE hE let Pool := crossPairPool (Finset.Ico u c) (Finset.Ioc c v) ∪ meetingOutsidePairs ((Finset.Icc 1 N).erase c) ((Finset.Icc u v).erase c) P have hleftF : u = c ∨ ∃ T ∈ F, (∃ l : ℕ∞, (T : Set ℕ).IsAPOfLength l) ∧ Finset.Icc u c ⊆ T := by rcases hleft with hh | ⟨T, hT, hAP, hcover⟩ · exact Or.inl hh · exact Or.inr ⟨T, hEF hT, hAP, hcover⟩ have hrightF : v = c ∨ ∃ T ∈ F, (∃ l : ℕ∞, (T : Set ℕ).IsAPOfLength l) ∧ Finset.Icc c v ⊆ T := by rcases hright with hh | ⟨T, hT, hAP, hcover⟩ · exact Or.inl hh · exact Or.inr ⟨T, hEF hT, hAP, hcover⟩ have hGD : G.card+D.card ≤ Pool.card := by apply private_pairs_and_intervals_card_le hF (hGC.trans hCF) (hDE.trans hEF) (fun S hS => hcC S (hGC hS)) (fun S hS => hC S (hGC hS)) · intro S hS obtain ⟨Q, hQ, hQP⟩ := (Finset.mem_filter.mp hS).2 exact ⟨Q, hQ, crooked_witness_in_interval_pool hF (hCF (hGC hS)) huc hcv (hcC S (hGC hS)) (hC S (hGC hS)) hleftF hrightF hQ hQP⟩ · intro S hS obtain ⟨l, r, hul, hlc, hcr, hrv, hrep⟩ := henvelope S (hDE hS) obtain ⟨⟨x, hx, hxc⟩, y, hy, hcy⟩ := (Finset.mem_filter.mp hS).2 have hxI := Finset.mem_Icc.mp (hrep ▸ hx) have hyI := Finset.mem_Icc.mp (hrep ▸ hy) have hlc' : l < c := by omega have hcr' : c < r := by omega refine ⟨l, r, hlc', hcr', hrep, ?_⟩ apply Finset.mem_union_left exact Finset.mem_image.mpr ⟨(l,r), Finset.mem_product.mpr ⟨Finset.mem_Ico.mpr ⟨hul, hlc'⟩, Finset.mem_Ioc.mpr ⟨hcr', hrv⟩⟩, rfl⟩ have hPool : (Pool.card : ℝ) ≤ 5*(N : ℝ)^2/18+3*N := interval_witness_pool_card_le hN hk hu huc hcv hvN hP hcP hmod have hGDR : (G.card : ℝ)+(D.card : ℝ) ≤ Pool.card := by exact_mod_cast hGD have hBR : (B.card : ℝ) ≤ witnessExceptionBound N c := by exact_mod_cast hB have hJR : (J.card : ℝ) ≤ 2*(N : ℝ) := by exact_mod_cast hJ have hCpart : (G.card : ℝ)+(B.card : ℝ) = C.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := C) Good have hEpart : (D.card : ℝ)+(J.card : ℝ) = E.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := E) (StraddlesRoot c) linarith only [hGDR, hBR, hJR, hCpart, hEpart, hPool] end /- NonintervalProgressionCount -/ /- The progression count with ordinary intervals omitted. -/ section open Finset def IsInterval (S : Finset ℕ) : Prop := ∃ a b : ℕ, S = Finset.Icc a b theorem natAP_step_one_isInterval (a m : ℕ) : IsInterval (natAP a 1 m) := by by_cases hm : m = 0 · refine ⟨1, 0, ?_⟩ simp [hm, natAP] · refine ⟨a, a+(m-1), ?_⟩ ext x constructor · intro hx have hh := natAP_bounds_of_mem hx exact Finset.mem_Icc.mpr (by simpa only [Nat.mul_one] using hh) · intro hx obtain ⟨hax, hxtop⟩ := Finset.mem_Icc.mp hx exact mem_natAP.mpr ⟨x-a, by omega, by omega⟩ theorem reciprocal_square_tail_two_le (N : ℕ) : (∑ i ∈ Finset.Icc 2 N, ((i : ℝ)^2)⁻¹) ≤ 2/3 := by by_cases hN : 1 ≤ N · have hsplit : Finset.Icc 1 N = insert 1 (Finset.Icc 2 N) := by ext i simp only [Finset.mem_Icc, Finset.mem_insert] omega have hh := reciprocal_square_sum_le N rw [hsplit, Finset.sum_insert (by simp)] at hh norm_num only [Nat.cast_one, one_pow, inv_one] at hh linarith only [hh] · have hzero : N = 0 := by omega norm_num [hzero] theorem progression_family_large_steps_card_le {N : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hcard : ∀ S ∈ F, 4 ≤ S.card) (hparam : ∀ S ∈ F, ∃ a d : ℕ, 2 ≤ d ∧ d ≤ N ∧ S = natAP a d S.card) : (F.card : ℝ) ≤ (N : ℝ)^2/6 + (N : ℝ)*reciprocalSum N + N := by classical have hparam' : ∀ S : Finset ℕ, ∃ a d : ℕ, S ∈ F → 2 ≤ d ∧ d ≤ N ∧ S = natAP a d S.card := by intro S by_cases hS : S ∈ F · obtain ⟨a,d,hd,hdN,hrep⟩ := hparam S hS exact ⟨a,d,fun _ => ⟨hd,hdN,hrep⟩⟩ · exact ⟨0,2,fun hh => False.elim (hS hh)⟩ choose a d hspec using hparam' have hmaps : Set.MapsTo d (F : Set (Finset ℕ)) (Finset.Icc 2 N : Set ℕ) := by intro S hS exact Finset.mem_Icc.mpr ⟨(hspec S hS).1, (hspec S hS).2.1⟩ have hsumCard : (F.card : ℝ) = ∑ k ∈ Finset.Icc 2 N, ((F.filter (fun S => d S = k)).card : ℝ) := by exact_mod_cast Finset.card_eq_sum_card_fiberwise hmaps have hbound : ∀ k ∈ Finset.Icc 2 N, ((F.filter (fun S => d S = k)).card : ℝ) ≤ (N : ℝ)^2/(4*(k : ℝ)^2)+(N : ℝ)/k+1 := by intro k hk apply same_step_family_card_le (by have hh := Finset.mem_Icc.mp hk; omega) (admissible_subfamily hF (Finset.filter_subset _ _)) · intro S hS exact hcard S (Finset.mem_filter.mp hS).1 · intro S hS obtain ⟨hSF, hdk⟩ := Finset.mem_filter.mp hS exact ⟨a S, by simpa only [hdk] using (hspec S hSF).2.2⟩ have hinv : (∑ k ∈ Finset.Icc 2 N, (k : ℝ)⁻¹) ≤ reciprocalSum N := by apply Finset.sum_le_sum_of_subset_of_nonneg · intro k hk have hh := Finset.mem_Icc.mp hk exact Finset.mem_Icc.mpr ⟨by omega, hh.2⟩ · intro k _hk _hk' positivity have hcardI : ((Finset.Icc 2 N).card : ℝ) ≤ N := by exact_mod_cast (show (Finset.Icc 2 N).card ≤ N by rw [Nat.card_Icc]; omega) have hsum : (F.card : ℝ) ≤ (N : ℝ)^2/4*(∑ k ∈ Finset.Icc 2 N, ((k : ℝ)^2)⁻¹) + (N : ℝ)*(∑ k ∈ Finset.Icc 2 N, (k : ℝ)⁻¹)+(Finset.Icc 2 N).card := by calc (F.card : ℝ) ≤ ∑ k ∈ Finset.Icc 2 N, ((N : ℝ)^2/(4*(k : ℝ)^2)+(N : ℝ)/k+1) := by rw [hsumCard] exact Finset.sum_le_sum hbound _ = _ := by calc _ = ∑ k ∈ Finset.Icc 2 N, ((N : ℝ)^2/4*((k : ℝ)^2)⁻¹+(N : ℝ)*(k : ℝ)⁻¹+1) := by apply Finset.sum_congr rfl intro k _hk simp only [div_eq_mul_inv, mul_inv_rev] ring _ = _ := by simp only [Finset.sum_add_distrib, ← Finset.mul_sum, Finset.sum_const, nsmul_eq_mul, mul_one] have hquad := mul_le_mul_of_nonneg_left (reciprocal_square_tail_two_le N) (show 0 ≤ (N : ℝ)^2/4 by positivity) have hharm := mul_le_mul_of_nonneg_left hinv (Nat.cast_nonneg N : (0 : ℝ) ≤ N) linarith only [hsum, hquad, hharm, hcardI] theorem noninterval_progression_family_card_le {N : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hno : ∀ S ∈ F, ¬IsInterval S) : (F.card : ℝ) ≤ (N : ℝ)^2/6+(N : ℝ)*reciprocalSum N+19*N+3 := by classical let A := F.filter (fun S => 4 ≤ S.card) let B := F.filter (fun S => ¬4 ≤ S.card) have hA : (A.card : ℝ) ≤ (N : ℝ)^2/6+(N : ℝ)*reciprocalSum N+N := by apply progression_family_large_steps_card_le (admissible_subfamily hF (Finset.filter_subset _ _)) (fun S hS => (Finset.mem_filter.mp hS).2) intro S hS obtain ⟨hSF, hsize⟩ := Finset.mem_filter.mp hS obtain ⟨l, hl⟩ := hAP S hSF obtain ⟨a,d,hd,hrep⟩ := nat_ap_eq_natAP hl (by omega : 2 ≤ S.card) have hd2 : 2 ≤ d := by by_contra hn have hd1 : d = 1 := by omega apply hno S hSF rw [hrep, hd1] exact natAP_step_one_isInterval _ _ have hstep : a+d ∈ S := by rw [hrep] exact mem_natAP.mpr ⟨1, by omega, by simp⟩ have hdN : d ≤ N := by have hh := Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 hSF) hstep) omega exact ⟨a,d,hd2,hdN,hrep⟩ have hB : B.card ≤ 18*N+3 := by apply progression_family_small_card_le (admissible_subfamily hF (Finset.filter_subset _ _)) (fun S hS => hAP S (Finset.mem_filter.mp hS).1) intro S hS have hh := (Finset.mem_filter.mp hS).2 omega have hBR : (B.card : ℝ) ≤ 18*(N : ℝ)+3 := by exact_mod_cast hB have hpart : (A.card : ℝ)+(B.card : ℝ) = F.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := F) (fun S => 4 ≤ S.card) linarith only [hA, hBR, hpart] end /- LargeStepStraddling -/ /- The straddling gap when some avoiding progression has step at least three. -/ section open Finset Filter theorem interval_contains_straddled_root {c : ℕ} {S : Finset ℕ} (hinterval : IsInterval S) (hstraddle : StraddlesRoot c S) : c ∈ S := by obtain ⟨a,b,hrep⟩ := hinterval obtain ⟨⟨x,hx,hxc⟩,y,hy,hcy⟩ := hstraddle have hxI := Finset.mem_Icc.mp (hrep ▸ hx) have hyI := Finset.mem_Icc.mp (hrep ▸ hy) rw [hrep] exact Finset.mem_Icc.mpr ⟨by omega, by omega⟩ theorem large_step_straddling_family_card_le {N c : ℕ} {F : Finset (Finset ℕ)} (hN : 6 ≤ N) (hcI : c ∈ Finset.Icc 1 N) (hF : Erdos272.IsArithInterSet N F) (hcC : ∀ S ∈ F, IsCrooked S → c ∈ S) (hstraddle : ∀ S ∈ F, c ∉ S → StraddlesRoot c S) (hlarge : ∃ P ∈ F, c ∉ P ∧ ∃ a k : ℕ, 3 ≤ k ∧ P = natAP a k P.card) : (F.card : ℝ) ≤ 4*(N : ℝ)^2/9+(N : ℝ)*reciprocalSum N+24*N+3+ 48*N*((Nat.log 2 N+1 : ℕ) : ℝ)^3 := by classical obtain ⟨P,hPF,hcP,a,k,hk,hrepP⟩ := hlarge let C := F.filter IsCrooked let H := F.filter (fun S => ¬IsCrooked S) let E := H.filter IsInterval let A := H.filter (fun S => ¬IsInterval S) have hCF : C ⊆ F := Finset.filter_subset _ _ have hHF : H ⊆ F := Finset.filter_subset _ _ have hEH : E ⊆ H := Finset.filter_subset _ _ have hAH : A ⊆ H := Finset.filter_subset _ _ have hCroot : ∀ S ∈ C, c ∈ S := fun S hS => hcC S (hCF hS) (Finset.mem_filter.mp hS).2 have hEroot : ∀ S ∈ E, c ∈ S := by intro S hS by_contra hc exact hc (interval_contains_straddled_root (Finset.mem_filter.mp hS).2 (hstraddle S (hHF (hEH hS)) hc)) have hPne : P.Nonempty := by obtain ⟨x,hx,_hxc⟩ := (hstraddle P hPF hcP).1 exact ⟨x,hx⟩ have hPmod : ∀ x ∈ P, Nat.ModEq k a x := by intro x hx obtain ⟨i,_hi,rfl⟩ := mem_natAP.mp (hrepP ▸ hx) change a%k = (a+i*k)%k simp only [Nat.add_mul_mod_self_right] have hmet : ∀ S ∈ C, (S.erase c ∩ P).Nonempty := by intro S hS obtain ⟨x,hx⟩ := arithInter_inter_nonempty hF hPF (hCF hS) hPne obtain ⟨hxP,hxS⟩ := Finset.mem_inter.mp hx have hxc : x ≠ c := by intro heq; exact hcP (heq ▸ hxP) exact ⟨x,Finset.mem_inter.mpr ⟨Finset.mem_erase.mpr ⟨hxc,hxS⟩,hxP⟩⟩ have hCE := crooked_and_intervals_meeting_sparse_residue_card_le hN hk hcI hF hCF (hEH.trans hHF) hCroot (fun S hS => (Finset.mem_filter.mp hS).2) hEroot (fun S hS => (Finset.mem_filter.mp hS).2) (Finset.mem_powerset.mp (hF.1 hPF)) hcP hPmod hmet have hA := noninterval_progression_family_card_le (admissible_subfamily hF (hAH.trans hHF)) (fun S hS => of_not_not (Finset.mem_filter.mp (hAH hS)).2) (fun S hS => (Finset.mem_filter.mp hS).2) have hCpart : (C.card : ℝ)+(H.card : ℝ) = F.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := F) IsCrooked have hHpart : (E.card : ℝ)+(A.card : ℝ) = H.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := H) IsInterval have herr : (witnessExceptionBound N c : ℝ) ≤ 48*(N : ℝ)*((Nat.log 2 N+1 : ℕ) : ℝ)^3 := by exact_mod_cast witnessExceptionBound_le_natLog hcI linarith only [hCE,hA,hCpart,hHpart,herr] theorem eventually_large_step_straddling_gap : ∀ᶠ N : ℕ in atTop, ∀ (F : Finset (Finset ℕ)) (c : ℕ), c ∈ Finset.Icc 1 N → Erdos272.IsArithInterSet N F → (∀ S ∈ F, IsCrooked S → c ∈ S) → (∀ S ∈ F, c ∉ S → StraddlesRoot c S) → (∃ P ∈ F, c ∉ P ∧ ∃ a k : ℕ, 3 ≤ k ∧ P = natAP a k P.card) → (F.card : ℝ) ≤ 17*(N : ℝ)^2/36 := by filter_upwards [eventually_const_mul_natLog_pow_le 7200 3, Filter.eventually_ge_atTop 1000000] with N hlog hN F c hcI hF hcC hstraddle hlarge have hbound := large_step_straddling_family_card_le (by omega) hcI hF hcC hstraddle hlarge let L := Nat.log 2 N+1 have hL : 1 ≤ L := by dsimp [L]; omega have hLL : L ≤ L^3 := by have hLsq : 1 ≤ L^2 := by nlinarith only [hL] have hh := Nat.mul_le_mul_left L hLsq nlinarith only [hh] have hLLR : (L : ℝ) ≤ (L : ℝ)^3 := by exact_mod_cast hLL have hrecip : reciprocalSum N ≤ 2*(L : ℝ) := by simpa only [L, Nat.cast_add, Nat.cast_one] using reciprocalSum_le_natLog N have hrecipmul := mul_le_mul_of_nonneg_left hrecip (Nat.cast_nonneg N : (0 : ℝ) ≤ N) have hLLmul := mul_le_mul_of_nonneg_left hLLR (Nat.cast_nonneg N : (0 : ℝ) ≤ N) have hlogR : 7200*(L : ℝ)^3 ≤ (N : ℝ) := by exact_mod_cast hlog have hlogmul := mul_le_mul_of_nonneg_left hlogR (Nat.cast_nonneg N : (0 : ℝ) ≤ N) have hNR : (1000000 : ℝ) ≤ N := by exact_mod_cast hN have hNmul := mul_le_mul_of_nonneg_left hNR (Nat.cast_nonneg N : (0 : ℝ) ≤ N) change (F.card : ℝ) ≤ 4*(N : ℝ)^2/9+(N : ℝ)*reciprocalSum N+24*N+3+48*N*(L : ℝ)^3 at hbound nlinarith only [hbound,hrecipmul,hLLmul,hlogmul,hNR,hNmul] end /- StraddlingReduction -/ /- Reduction of a near-extremal mixed family to a one-sided avoiding progression. -/ section open Finset Filter theorem straddling_AP_has_step_two_le {c : ℕ} {S : Finset ℕ} (hc : c ∉ S) (hstraddle : StraddlesRoot c S) (hAP : ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) : ∃ a d : ℕ, 2 ≤ d ∧ S = natAP a d S.card := by have hcard : 2 ≤ S.card := by by_contra hn obtain ⟨⟨x,hx,hxc⟩,y,hy,hcy⟩ := hstraddle have hxy := Finset.card_le_one.mp (by omega : S.card ≤ 1) x hx y hy omega obtain ⟨l,hl⟩ := hAP obtain ⟨a,d,hd,hrep⟩ := nat_ap_eq_natAP hl hcard have hd2 : 2 ≤ d := by by_contra hn have hd1 : d = 1 := by omega apply hc apply interval_contains_straddled_root (S := S) ?_ hstraddle rw [hrep,hd1] exact natAP_step_one_isInterval _ _ exact ⟨a,d,hd2,hrep⟩ theorem eventually_straddling_gap : ∀ᶠ N : ℕ in atTop, ∀ (F : Finset (Finset ℕ)) (c : ℕ), c ∈ Finset.Icc 1 N → Erdos272.IsArithInterSet N F → (∀ S ∈ F, IsCrooked S → c ∈ S) → (∀ S ∈ F, c ∉ S → StraddlesRoot c S) → (∃ P ∈ F, c ∉ P) → (F.card : ℝ) ≤ 17*(N : ℝ)^2/36 := by classical filter_upwards [eventually_large_step_straddling_gap, eventually_two_step_straddling_gap] with N hlarge htwo F c hcI hF hcC hstraddle houtside by_cases hbig : ∃ P ∈ F, c ∉ P ∧ ∃ a k : ℕ, 3 ≤ k ∧ P = natAP a k P.card · exact hlarge F c hcI hF hcC hstraddle hbig · have hrep : ∀ S ∈ F, c ∉ S → ∃ a, S = natAP a 2 S.card := by intro S hS hcS have hAP : ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l := by by_contra hnot exact hcS (hcC S hS hnot) obtain ⟨a,d,hd,hSd⟩ := straddling_AP_has_step_two_le hcS (hstraddle S hS hcS) hAP have hd2 : d = 2 := by by_contra hn exact hbig ⟨S,hS,hcS,a,d,by omega,hSd⟩ exact ⟨a,by simpa only [hd2] using hSd⟩ have htwobound := htwo F c hcI hF hrep (by obtain ⟨P,hP,hcP⟩ := houtside exact ⟨P,hP,hcP,hstraddle P hP hcP⟩) nlinarith only [htwobound,sq_nonneg (N : ℝ)] theorem not_straddling_one_sided {c : ℕ} {S : Finset ℕ} (hc : c ∉ S) (hnot : ¬StraddlesRoot c S) : (∀ x ∈ S, x < c) ∨ ∀ x ∈ S, c < x := by by_cases hleft : ∃ x ∈ S, x < c · apply Or.inl intro y hy have hcy : y ≠ c := by intro heq; exact hc (heq ▸ hy) by_contra hn exact hnot ⟨hleft,y,hy,by omega⟩ · apply Or.inr intro x hx have hxc : x ≠ c := by intro heq; exact hc (heq ▸ hx) by_contra hn exact hleft ⟨x,hx,by omega⟩ theorem eventually_near_extremal_one_sided_reduction : ∀ᶠ N : ℕ in atTop, ∀ (F : Finset (Finset ℕ)) (c : ℕ), c ∈ Finset.Icc 1 N → Erdos272.IsArithInterSet N F → (∀ S ∈ F, IsCrooked S → c ∈ S) → (N : ℝ)^2/2 ≤ (F.card : ℝ)+2048*N → (∀ S ∈ F, c ∈ S) ∨ ∃ P ∈ F, c ∉ P ∧ ((∀ x ∈ P, x < c) ∨ ∀ x ∈ P, c < x) := by classical filter_upwards [eventually_straddling_gap,Filter.eventually_ge_atTop 1000000] with N hgap hN F c hcI hF hcC hlarge by_cases hcommon : ∀ S ∈ F, c ∈ S · exact Or.inl hcommon · apply Or.inr by_contra hno have hstraddle : ∀ S ∈ F, c ∉ S → StraddlesRoot c S := by intro S hS hcS by_contra hn exact hno ⟨S,hS,hcS,not_straddling_one_sided hcS hn⟩ have houtside : ∃ P ∈ F, c ∉ P := by push Not at hcommon exact hcommon have hbound := hgap F c hcI hF hcC hstraddle houtside have hNR : (1000000 : ℝ) ≤ N := by exact_mod_cast hN have hNmul := mul_le_mul_of_nonneg_left hNR (Nat.cast_nonneg N : (0 : ℝ) ≤ N) nlinarith only [hbound,hlarge,hNR,hNmul] theorem eventually_one_sided_crooked_reduction : ∀ᶠ N : ℕ in atTop, ∀ F : Finset (Finset ℕ), Erdos272.IsArithInterSet N F → (N : ℝ)^2/2 ≤ (F.card : ℝ) → ∃ G : Finset (Finset ℕ), G ⊆ F ∧ Erdos272.IsArithInterSet N G ∧ F.card ≤ G.card+2048*N ∧ ∃ c ∈ Finset.Icc 1 N, (∀ S ∈ G, IsCrooked S → c ∈ S) ∧ ((∀ S ∈ G, c ∈ S) ∨ ∃ P ∈ G, c ∉ P ∧ ((∀ x ∈ P, x < c) ∨ ∀ x ∈ P, c < x)) := by filter_upwards [eventually_common_crooked_reduction,eventually_near_extremal_one_sided_reduction] with N hcommon hside F hF hlarge obtain ⟨G,hGF,hG,hcard,c,hcI,hcG⟩ := hcommon F hF hlarge have hlargeG : (N : ℝ)^2/2 ≤ (G.card : ℝ)+2048*N := by have hcardR : (F.card : ℝ) ≤ (G.card : ℝ)+2048*N := by exact_mod_cast hcard exact hlarge.trans hcardR exact ⟨G,hGF,hG,hcard,c,hcI,hcG,hside G c hcI hG hcG hlargeG⟩ end /- WitnessRedirect -/ /- Redirecting intrinsic witnesses through a neighbor of the root. -/ section open Finset theorem cover_union_of_shared_consecutive {S A B : Finset ℕ} {u v : ℕ} (hcon : ConsecutiveIn S u v) (hA : HasAPCover S A) (hB : HasAPCover S B) (huA : u ∈ A) (hvA : v ∈ A) (huB : u ∈ B) (hvB : v ∈ B) : HasAPCover S (A ∪ B) := by obtain ⟨U,hUS,hU,hAU⟩ := hA obtain ⟨V,hVS,hV,hBV⟩ := hB exact ⟨U ∪ V,Finset.union_subset hUS hVS, isAP_union_of_consecutive hU hV (hcon.subset hUS (hAU huA) (hAU hvA)) (hcon.subset hVS (hBV huB) (hBV hvB)), Finset.union_subset_union hAU hBV⟩ theorem hasAPCover_mono {S A B : Finset ℕ} (hcover : HasAPCover S B) (hAB : A ⊆ B) : HasAPCover S A := by obtain ⟨U,hUS,hAP,hBU⟩ := hcover exact ⟨U,hUS,hAP,hAB.trans hBU⟩ theorem witness_pair_redirect_neighbor {S : Finset ℕ} {c z x y : ℕ} (hneighbor : ConsecutiveIn S c z ∨ ConsecutiveIn S z c) (hW : IsWitnessPair S c {x,y}) : IsWitnessPair S c {z,x} ∨ IsWitnessPair S c {z,y} := by classical by_cases hzx : z = x · exact Or.inr (by simpa only [hzx] using hW) by_cases hzy : z = y · exact Or.inl (by simpa only [hzy,Finset.pair_comm] using hW) have hz : z ∈ S.erase c := by rcases hneighbor with hcz | hzc · exact Finset.mem_erase.mpr ⟨hcz.2.2.1.ne',hcz.2.1⟩ · exact Finset.mem_erase.mpr ⟨hzc.2.2.1.ne,hzc.1⟩ have hx : x ∈ S.erase c := hW.2.1 (by simp) have hy : y ∈ S.erase c := hW.2.1 (by simp) by_contra hnot have hxnot : ¬IsWitnessPair S c {z,x} := fun hh => hnot (Or.inl hh) have hynot : ¬IsWitnessPair S c {z,y} := fun hh => hnot (Or.inr hh) have hX := hasAPCover_of_not_witness (by simp [hzx] : ({z,x} : Finset ℕ).card = 2) (show ({z,x} : Finset ℕ) ⊆ S.erase c by simp only [Finset.insert_subset_iff,Finset.singleton_subset_iff] exact ⟨hz,hx⟩) hxnot have hY := hasAPCover_of_not_witness (by simp [hzy] : ({z,y} : Finset ℕ).card = 2) (show ({z,y} : Finset ℕ) ⊆ S.erase c by simp only [Finset.insert_subset_iff,Finset.singleton_subset_iff] exact ⟨hz,hy⟩) hynot have hcover : HasAPCover S ((insert c {z,x}) ∪ (insert c {z,y})) := by rcases hneighbor with hcz | hzc · exact cover_union_of_shared_consecutive hcz hX hY (by simp) (by simp) (by simp) (by simp) · exact cover_union_of_shared_consecutive hzc hX hY (by simp) (by simp) (by simp) (by simp) apply hW.2.2 apply hasAPCover_mono hcover intro t ht simp only [Finset.mem_insert,Finset.mem_singleton] at ht rcases ht with rfl | rfl | rfl <;> simp theorem exists_root_neighbor_le {S : Finset ℕ} {c t R : ℕ} (hc : c ∈ S) (ht : t ∈ S) (htc : t ≠ c) (hcR : c ≤ R) (htR : t ≤ R) : ∃ z, z ≤ R ∧ (ConsecutiveIn S c z ∨ ConsecutiveIn S z c) := by rcases lt_or_gt_of_ne htc with htc | hct · obtain ⟨z,hzc⟩ := exists_consecutive_left_of_mem ht hc htc exact ⟨z,hzc.2.2.1.le.trans hcR,Or.inr hzc⟩ · obtain ⟨z,hcz⟩ := exists_consecutive_right_of_mem hc ht hct have hzt : z ≤ t := by by_contra hn exact hcz.2.2.2 t ht ⟨hct,by omega⟩ exact ⟨z,hzt.trans htR,Or.inl hcz⟩ theorem witness_meeting_right_can_reach_left {S Q : Finset ℕ} {c t L R : ℕ} (hc : c ∈ S) (ht : t ∈ S) (htc : t ≠ c) (hcR : c ≤ R) (htR : t ≤ R) (hLR : L ≤ R) (hW : IsWitnessPair S c Q) (hhigh : ∃ x ∈ Q, L ≤ x) : ∃ W, IsWitnessPair S c W ∧ (∃ x ∈ W, L ≤ x) ∧ ∃ y ∈ W, y ≤ R := by classical by_cases hlow : ∃ y ∈ Q, y ≤ R · exact ⟨Q,hW,hhigh,hlow⟩ · obtain ⟨x,y,_hxy,hQrep⟩ := Finset.card_eq_two.mp hW.1 have hRx : R < x := by by_contra hn apply hlow exact ⟨x,by simp [hQrep],by omega⟩ have hRy : R < y := by by_contra hn apply hlow exact ⟨y,by simp [hQrep],by omega⟩ obtain ⟨z,hzR,hneighbor⟩ := exists_root_neighbor_le hc ht htc hcR htR have hpair : IsWitnessPair S c {x,y} := by simpa only [hQrep] using hW rcases witness_pair_redirect_neighbor hneighbor hpair with hzx | hzy · exact ⟨{z,x},hzx,⟨x,by simp,hLR.trans hRx.le⟩,z,by simp,hzR⟩ · exact ⟨{z,y},hzy,⟨y,by simp,hLR.trans hRy.le⟩,z,by simp,hzR⟩ end /- FamilyReflection -/ /- Reflection preserves admissible families and their common crooked root. -/ section open Finset theorem reflectSet_inter {N : ℕ} {S T : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) (hT : T ⊆ Finset.Icc 1 N) : reflectSet N (S ∩ T) = reflectSet N S ∩ reflectSet N T := by ext x constructor · intro hx obtain ⟨y,hy,rfl⟩ := Finset.mem_image.mp hx obtain ⟨hyS,hyT⟩ := Finset.mem_inter.mp hy exact Finset.mem_inter.mpr ⟨Finset.mem_image.mpr ⟨y,hyS,rfl⟩, Finset.mem_image.mpr ⟨y,hyT,rfl⟩⟩ · intro hx obtain ⟨hxS,hxT⟩ := Finset.mem_inter.mp hx obtain ⟨y,hy,hyx⟩ := Finset.mem_image.mp hxS obtain ⟨z,hz,hzx⟩ := Finset.mem_image.mp hxT have hyz : y = z := reflectPoint_injOn N (hS hy) (hT hz) (hyx.trans hzx.symm) exact Finset.mem_image.mpr ⟨y,Finset.mem_inter.mpr ⟨hy,hyz.symm ▸ hz⟩,hyx⟩ theorem reflectSet_isCrooked_iff {N : ℕ} {S : Finset ℕ} (hS : S ⊆ Finset.Icc 1 N) : IsCrooked (reflectSet N S) ↔ IsCrooked S := by constructor · intro hnot hAP exact hnot (reflectSet_isAP hS hAP) · intro hnot hAP have hh := reflectSet_isAP (reflectSet_subset hS) hAP rw [reflectSet_involutive hS] at hh exact hnot hh def reflectFamily (N : ℕ) (F : Finset (Finset ℕ)) : Finset (Finset ℕ) := F.image (reflectSet N) theorem reflectFamily_card {N : ℕ} {F : Finset (Finset ℕ)} (hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N) : (reflectFamily N F).card = F.card := by apply Finset.card_image_of_injOn intro S hS T hT heq have hh := congrArg (reflectSet N) heq simpa only [reflectSet_involutive (hsub S hS), reflectSet_involutive (hsub T hT)] using hh theorem reflectFamily_admissible {N : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) : Erdos272.IsArithInterSet N (reflectFamily N F) := by have hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N := fun S hS => Finset.mem_powerset.mp (hF.1 hS) constructor · intro S hS obtain ⟨T,hT,rfl⟩ := Finset.mem_image.mp hS exact Finset.mem_powerset.mpr (reflectSet_subset (hsub T hT)) · intro S hS T hT hST obtain ⟨A,hA,rfl⟩ := Finset.mem_image.mp hS obtain ⟨B,hB,rfl⟩ := Finset.mem_image.mp hT have hAB : A ≠ B := by intro heq; apply hST; rw [heq] obtain ⟨l,hl,hAP⟩ := hF.2 hA hB hAB obtain ⟨m,hm⟩ := reflectSet_isAP (Finset.inter_subset_left.trans (hsub A hA)) ⟨l,hAP⟩ have hne : (reflectSet N (A ∩ B)).Nonempty := (arithInter_nonempty hF hA hB hAB).image (reflectPoint N) have hmpos : 0 < m := by by_contra hn have hmzero : m = 0 := le_antisymm (le_of_not_gt hn) bot_le have hz := Set.IsAPOfLength.zero.mp (hmzero ▸ hm) obtain ⟨x,hx⟩ := hne have hxSet : x ∈ (reflectSet N (A ∩ B) : Set ℕ) := hx rw [hz] at hxSet exact hxSet refine ⟨m,hmpos,?_⟩ simpa only [reflectSet_inter (hsub A hA) (hsub B hB)] using hm theorem reflectFamily_crooked_root {N c : ℕ} {F : Finset (Finset ℕ)} (hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N) (hc : ∀ S ∈ F, IsCrooked S → c ∈ S) : ∀ S ∈ reflectFamily N F, IsCrooked S → reflectPoint N c ∈ S := by intro S hS hcrooked obtain ⟨T,hT,rfl⟩ := Finset.mem_image.mp hS exact Finset.mem_image.mpr ⟨c,hc T hT ((reflectSet_isCrooked_iff (hsub T hT)).mp hcrooked),rfl⟩ theorem reflect_left_avoider {N c : ℕ} {S : Finset ℕ} (hsub : S ⊆ Finset.Icc 1 N) (hcI : c ∈ Finset.Icc 1 N) (hleft : ∀ x ∈ S, x < c) : ∀ x ∈ reflectSet N S, reflectPoint N c < x := by intro x hx obtain ⟨y,hy,rfl⟩ := Finset.mem_image.mp hx have hcy := hleft y hy have hyN := Finset.mem_Icc.mp (hsub hy) have hcN := Finset.mem_Icc.mp hcI dsimp only [reflectPoint] omega end /- RightAvoiderReduction -/ /- Orienting the remaining structural case so an avoiding progression lies to the right. -/ section open Finset Filter theorem right_avoider_reduction_of_one_sided {N c : ℕ} {F : Finset (Finset ℕ)} (hcI : c ∈ Finset.Icc 1 N) (hF : Erdos272.IsArithInterSet N F) (hcC : ∀ S ∈ F, IsCrooked S → c ∈ S) (hcase : (∀ S ∈ F, c ∈ S) ∨ ∃ P ∈ F, c ∉ P ∧ ((∀ x ∈ P, x < c) ∨ ∀ x ∈ P, c < x)) : ∃ G : Finset (Finset ℕ), Erdos272.IsArithInterSet N G ∧ G.card = F.card ∧ ∃ d ∈ Finset.Icc 1 N, (∀ S ∈ G, IsCrooked S → d ∈ S) ∧ ((∀ S ∈ G, d ∈ S) ∨ ∃ P ∈ G, ∀ x ∈ P, d < x) := by have hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N := fun S hS => Finset.mem_powerset.mp (hF.1 hS) rcases hcase with hcommon | ⟨P,hP,_hcP,hleft | hright⟩ · exact ⟨F,hF,rfl,c,hcI,hcC,Or.inl hcommon⟩ · refine ⟨reflectFamily N F,reflectFamily_admissible hF,reflectFamily_card hsub, reflectPoint N c,reflectPoint_mem hcI,reflectFamily_crooked_root hsub hcC,Or.inr ?_⟩ exact ⟨reflectSet N P,Finset.mem_image.mpr ⟨P,hP,rfl⟩, reflect_left_avoider (hsub P hP) hcI hleft⟩ · exact ⟨F,hF,rfl,c,hcI,hcC,Or.inr ⟨P,hP,hright⟩⟩ theorem eventually_right_avoider_crooked_reduction : ∀ᶠ N : ℕ in atTop, ∀ F : Finset (Finset ℕ), Erdos272.IsArithInterSet N F → (N : ℝ)^2/2 ≤ (F.card : ℝ) → ∃ G : Finset (Finset ℕ), Erdos272.IsArithInterSet N G ∧ F.card ≤ G.card+2048*N ∧ ∃ c ∈ Finset.Icc 1 N, (∀ S ∈ G, IsCrooked S → c ∈ S) ∧ ((∀ S ∈ G, c ∈ S) ∨ ∃ P ∈ G, ∀ x ∈ P, c < x) := by filter_upwards [eventually_one_sided_crooked_reduction] with N hreduce F hF hlarge obtain ⟨G,_hGF,hG,hcard,c,hcI,hcG,hcase⟩ := hreduce F hF hlarge obtain ⟨H,hH,hHcard,d,hdI,hdH,hHcase⟩ := right_avoider_reduction_of_one_sided hcI hG hcG hcase refine ⟨H,hH,?_,d,hdI,hdH,hHcase⟩ simpa only [hHcard] using hcard end /- OutsideEnvelope -/ /- Extremal endpoints for the avoiding family in the remaining one-sided case. -/ section open Finset theorem admissible_member_nonempty_of_card_two_le {N : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hcard : 2 ≤ F.card) : ∀ S ∈ F, S.Nonempty := by intro S hS have hpos : 0 < (F.erase S).card := by rw [Finset.card_erase_of_mem hS]; omega obtain ⟨T,hT⟩ := Finset.card_pos.mp hpos obtain ⟨hTS,hTF⟩ := Finset.mem_erase.mp hT exact (arithInter_nonempty hF hS hTF hTS.symm).mono Finset.inter_subset_left theorem near_extremal_card_two_le {N : ℕ} {F : Finset (Finset ℕ)} (hN : 10000 ≤ N) (hlarge : (N : ℝ)^2/2 ≤ (F.card : ℝ)+2048*N) : 2 ≤ F.card := by by_contra hn have hcard : (F.card : ℝ) ≤ 1 := by exact_mod_cast (show F.card ≤ 1 by omega) have hNR : (10000 : ℝ) ≤ N := by exact_mod_cast hN have hNmul := mul_le_mul_of_nonneg_left hNR (Nat.cast_nonneg N : (0 : ℝ) ≤ N) nlinarith only [hcard,hNR,hNmul,hlarge] theorem outside_member_envelope {N c : ℕ} {F : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hNonempty : ∀ S ∈ F, S.Nonempty) (hHasRight : ∃ P ∈ F, ∀ x ∈ P, c < x) : ∃ L R : ℕ, c < L ∧ L ≤ R ∧ R ≤ N ∧ (∃ P ∈ F, c ∉ P ∧ ∀ x ∈ P, L ≤ x) ∧ (∃ T ∈ F, c ∉ T ∧ ∀ x ∈ T, x ≤ R) ∧ ∀ S ∈ F, c ∉ S → (∃ a ∈ S, a ≤ L ∧ ∀ x ∈ S, a ≤ x) ∧ ∃ b ∈ S, R ≤ b ∧ ∀ x ∈ S, x ≤ b := by classical let A := F.filter (fun S => c ∉ S) let X := {S // S ∈ A} have hXF : ∀ S : X, S.val ∈ F := fun S => (Finset.mem_filter.mp S.property).1 let a (S : X) := S.val.min' (hNonempty S.val (hXF S)) let b (S : X) := S.val.max' (hNonempty S.val (hXF S)) have ha : ∀ S : X, a S ∈ S.val := fun S => Finset.min'_mem _ _ have hb : ∀ S : X, b S ∈ S.val := fun S => Finset.max'_mem _ _ have hamin : ∀ S : X, ∀ x ∈ S.val, a S ≤ x := fun S x hx => Finset.min'_le _ _ hx have hbmax : ∀ S : X, ∀ x ∈ S.val, x ≤ b S := fun S x hx => Finset.le_max' _ _ hx obtain ⟨P,hPF,hRight⟩ := hHasRight have hcP : c ∉ P := by intro hh; exact (lt_irrefl c) (hRight c hh) let P₀ : X := ⟨P,Finset.mem_filter.mpr ⟨hPF,hcP⟩⟩ have hX : (Finset.univ : Finset X).Nonempty := ⟨P₀,Finset.mem_univ _⟩ obtain ⟨PL,_hPL,hmaxa⟩ := Finset.exists_max_image Finset.univ a hX obtain ⟨PR,_hPR,hminb⟩ := Finset.exists_min_image Finset.univ b hX have hcL : c < a PL := (hRight (a P₀) (ha P₀)).trans_le (hmaxa P₀ (Finset.mem_univ _)) obtain ⟨x,hx⟩ := arithInter_inter_nonempty hF (hXF PL) (hXF PR) (hNonempty PL.val (hXF PL)) obtain ⟨hxPL,hxPR⟩ := Finset.mem_inter.mp hx have hLR : a PL ≤ b PR := (hamin PL x hxPL).trans (hbmax PR x hxPR) have hRN : b PR ≤ N := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 (hXF PR)) (hb PR))).2 refine ⟨a PL,b PR,hcL,hLR,hRN,?_,?_,?_⟩ · exact ⟨PL.val,hXF PL,(Finset.mem_filter.mp PL.property).2,hamin PL⟩ · exact ⟨PR.val,hXF PR,(Finset.mem_filter.mp PR.property).2,hbmax PR⟩ · intro S hS hcS let T : X := ⟨S,Finset.mem_filter.mpr ⟨hS,hcS⟩⟩ exact ⟨⟨a T,ha T,hmaxa T (Finset.mem_univ _),hamin T⟩, b T,hb T,hminb T (Finset.mem_univ _),hbmax T⟩ theorem witness_reaches_avoider_endpoint {N c L R : ℕ} {F : Finset (Finset ℕ)} {S T Q : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hS : S ∈ F) (hT : T ∈ F) (hcS : c ∈ S) (hcT : c ∉ T) (hTbound : ∀ x ∈ T, x ≤ R) (hcR : c ≤ R) (hLR : L ≤ R) (hQ : IsWitnessPair S c Q) (hhigh : ∃ x ∈ Q, L ≤ x) : ∃ W, IsWitnessPair S c W ∧ (∃ x ∈ W, L ≤ x) ∧ ∃ y ∈ W, y ≤ R := by obtain ⟨t,ht⟩ := arithInter_inter_nonempty hF hS hT ⟨c,hcS⟩ obtain ⟨htS,htT⟩ := Finset.mem_inter.mp ht have htc : t ≠ c := by intro heq; exact hcT (heq ▸ htT) exact witness_meeting_right_can_reach_left hcS htS htc hcR (hTbound t htT) hLR hQ hhigh end /- WitnessPreference -/ /- Choosing a middle witness first, then a shortest exterior witness. -/ section open Finset def HasMiddleWitness (S : Finset ℕ) (c L R : ℕ) : Prop := ∃ Q, IsWitnessPair S c Q ∧ ∃ z ∈ Q, L ≤ z ∧ z ≤ R theorem pair_eq_of_card_two_of_mem {Q : Finset ℕ} {x y : ℕ} (hcard : Q.card = 2) (hx : x ∈ Q) (hy : y ∈ Q) (hxy : x ≠ y) : Q = {x,y} := by have hsub : ({x,y} : Finset ℕ) ⊆ Q := by simp only [Finset.insert_subset_iff,Finset.singleton_subset_iff] exact ⟨hx,hy⟩ exact (Finset.eq_of_subset_of_card_le hsub (by simp [hcard,hxy])).symm theorem preferred_one_sided_witness {S : Finset ℕ} {c L R : ℕ} (hLR : L ≤ R) (hreach : ∃ W, IsWitnessPair S c W ∧ (∃ x ∈ W, L ≤ x) ∧ ∃ y ∈ W, y ≤ R) : ∃ x p : ℕ, IsWitnessPair S c {x,p} ∧ L ≤ p ∧ (p ≤ R ∨ (x < L ∧ R < p ∧ ¬HasMiddleWitness S c L R ∧ ∀ u v : ℕ, u < L → R < v → IsWitnessPair S c {u,v} → p-x ≤ v-u)) := by classical by_cases hmiddle : HasMiddleWitness S c L R · obtain ⟨Q,hQ,p,hp,hLp,hpR⟩ := hmiddle obtain ⟨a,b,_hab,hrep⟩ := Finset.card_eq_two.mp hQ.1 rw [hrep] at hp simp only [Finset.mem_insert,Finset.mem_singleton] at hp rcases hp with hpa | hpb · exact ⟨b,p,by simpa only [hrep,hpa,Finset.pair_comm] using hQ,hLp,Or.inl hpR⟩ · exact ⟨a,p,by simpa only [hrep,hpb] using hQ,hLp,Or.inl hpR⟩ · obtain ⟨W,hW,⟨p,hp,hLp⟩,x,hx,hxR⟩ := hreach have hRp : R < p := by by_contra hn exact hmiddle ⟨W,hW,p,hp,hLp,by omega⟩ have hxL : x < L := by by_contra hn exact hmiddle ⟨W,hW,x,hx,by omega,hxR⟩ have hWrep : W = {x,p} := pair_eq_of_card_two_of_mem hW.1 hx hp (by omega) have hpair : IsWitnessPair S c {x,p} := by simpa only [hWrep] using hW let Candidate (d : ℕ) := ∃ u v : ℕ, u < L ∧ R < v ∧ IsWitnessPair S c {u,v} ∧ v-u = d have hex : ∃ d, Candidate d := ⟨p-x,x,p,hxL,hRp,hpair,rfl⟩ obtain ⟨u,v,huL,hRv,hUV,hd⟩ := Nat.find_spec hex refine ⟨u,v,hUV,hLR.trans hRv.le,Or.inr ⟨huL,hRv,hmiddle,?_⟩⟩ intro a b haL hRb hAB rw [hd] exact Nat.find_min' hex ⟨a,b,haL,hRb,hAB,rfl⟩ end /- CornerCrop -/ /- A shortest preferred corner witness has a two-point or crooked interval trace. -/ section open Finset theorem exists_consecutive_across_cut {S : Finset ℕ} {R x y : ℕ} (hx : x ∈ S) (hy : y ∈ S) (hxR : x ≤ R) (hRy : R < y) : ∃ b a, ConsecutiveIn S b a ∧ x ≤ b ∧ b ≤ R ∧ R < a ∧ a ≤ y := by let B := S.filter (fun z => z ≤ R) let A := S.filter (fun z => R < z) have hxB : x ∈ B := Finset.mem_filter.mpr ⟨hx,hxR⟩ have hyA : y ∈ A := Finset.mem_filter.mpr ⟨hy,hRy⟩ have hB : B.Nonempty := ⟨x,hxB⟩ have hA : A.Nonempty := ⟨y,hyA⟩ let b := B.max' hB let a := A.min' hA have hbB : b ∈ B := Finset.max'_mem B hB have haA : a ∈ A := Finset.min'_mem A hA obtain ⟨hbS,hbR⟩ := Finset.mem_filter.mp hbB obtain ⟨haS,hRa⟩ := Finset.mem_filter.mp haA refine ⟨b,a,⟨hbS,haS,by omega,?_⟩,Finset.le_max' B x hxB,hbR,hRa, Finset.min'_le A y hyA⟩ intro z hz hbetween by_cases hzR : z ≤ R · have hzB : z ∈ B := Finset.mem_filter.mpr ⟨hz,hzR⟩ have hzb : z ≤ b := Finset.le_max' B z hzB omega · have hzA : z ∈ A := Finset.mem_filter.mpr ⟨hz,by omega⟩ have haz : a ≤ z := Finset.min'_le A z hzA omega theorem card_inter_Icc_le_two_of_consecutive {S : Finset ℕ} {x y : ℕ} (hcon : ConsecutiveIn S x y) : (S ∩ Finset.Icc x y).card ≤ 2 := by have hsub : S ∩ Finset.Icc x y ⊆ ({x,y} : Finset ℕ) := by intro z hz obtain ⟨hzS,hzI⟩ := Finset.mem_inter.mp hz obtain ⟨hxz,hzy⟩ := Finset.mem_Icc.mp hzI by_cases hzx : z = x · simp [hzx] by_cases hzy' : z = y · simp [hzy'] exact False.elim (hcon.2.2.2 z hzS ⟨by omega,by omega⟩) have hh := Finset.card_le_card hsub simpa only [Finset.card_pair hcon.2.2.1.ne] using hh theorem preferred_corner_crop_AP_card_le_two {S : Finset ℕ} {c x p L R : ℕ} (hcx : c < x) (hxL : x < L) (hLR : L ≤ R) (hRp : R < p) (hW : IsWitnessPair S c {x,p}) (hnoMiddle : ¬HasMiddleWitness S c L R) (hminimum : ∀ u v : ℕ, u < L → R < v → IsWitnessPair S c {u,v} → p-x ≤ v-u) (hAP : ∃ l : ℕ∞, ((S ∩ Finset.Icc x p : Finset ℕ) : Set ℕ).IsAPOfLength l) : (S ∩ Finset.Icc x p).card ≤ 2 := by by_contra hsize have hxS : x ∈ S := Finset.mem_of_mem_erase (hW.2.1 (by simp)) have hpS : p ∈ S := Finset.mem_of_mem_erase (hW.2.1 (by simp)) obtain ⟨b,a,hcon,hxb,hbR,hRa,hap⟩ := exists_consecutive_across_cut hxS hpS (hxL.le.trans hLR) hRp have hends : b ≠ x ∨ a ≠ p := by by_contra hn have hb : b = x := by by_contra hh; exact hn (Or.inl hh) have ha : a = p := by by_contra hh; exact hn (Or.inr hh) exact hsize (card_inter_Icc_le_two_of_consecutive (by simpa only [hb,ha] using hcon)) have hshort : a-b < p-x := by rcases hends with hb | ha <;> omega have hnoBA : ¬IsWitnessPair S c {b,a} := by intro hBA by_cases hLb : L ≤ b · exact hnoMiddle ⟨{b,a},hBA,b,by simp,hLb,hbR⟩ · have hh := hminimum b a (by omega) hRa hBA omega have hbSc : b ∈ S.erase c := Finset.mem_erase.mpr ⟨by omega,hcon.1⟩ have haSc : a ∈ S.erase c := Finset.mem_erase.mpr ⟨by omega,hcon.2.1⟩ have hcover := hasAPCover_of_not_witness (by simp [hcon.2.2.1.ne] : ({b,a} : Finset ℕ).card = 2) (show ({b,a} : Finset ℕ) ⊆ S.erase c by simp only [Finset.insert_subset_iff,Finset.singleton_subset_iff] exact ⟨hbSc,haSc⟩) hnoBA obtain ⟨U,hUS,hUAP,hCU⟩ := hcover let C := S ∩ Finset.Icc x p have hbC : b ∈ C := Finset.mem_inter.mpr ⟨hcon.1,Finset.mem_Icc.mpr ⟨hxb,by omega⟩⟩ have haC : a ∈ C := Finset.mem_inter.mpr ⟨hcon.2.1,Finset.mem_Icc.mpr ⟨by omega,hap⟩⟩ have hAPunion : ∃ l : ℕ∞, ((U ∪ C : Finset ℕ) : Set ℕ).IsAPOfLength l := isAP_union_of_consecutive hUAP hAP (hcon.subset hUS (hCU (by simp)) (hCU (by simp))) (hcon.subset Finset.inter_subset_left hbC haC) apply hW.2.2 refine ⟨U ∪ C,Finset.union_subset hUS Finset.inter_subset_left,hAPunion,?_⟩ intro z hz simp only [Finset.mem_insert,Finset.mem_singleton] at hz rcases hz with rfl | rfl | rfl · exact Finset.mem_union_left _ (hCU (by simp)) · exact Finset.mem_union_right _ (Finset.mem_inter.mpr ⟨hxS,Finset.mem_Icc.mpr ⟨le_rfl,by omega⟩⟩) · exact Finset.mem_union_right _ (Finset.mem_inter.mpr ⟨hpS,Finset.mem_Icc.mpr ⟨by omega,le_rfl⟩⟩) theorem preferred_corner_crop_dichotomy {S : Finset ℕ} {c x p L R : ℕ} (hcx : c < x) (hxL : x < L) (hLR : L ≤ R) (hRp : R < p) (hW : IsWitnessPair S c {x,p}) (hnoMiddle : ¬HasMiddleWitness S c L R) (hminimum : ∀ u v : ℕ, u < L → R < v → IsWitnessPair S c {u,v} → p-x ≤ v-u) : S ∩ Finset.Icc x p = {x,p} ∨ IsCrooked (S ∩ Finset.Icc x p) := by by_cases hcrooked : IsCrooked (S ∩ Finset.Icc x p) · exact Or.inr hcrooked · apply Or.inl have hcard := preferred_corner_crop_AP_card_le_two hcx hxL hLR hRp hW hnoMiddle hminimum (of_not_not hcrooked) have hxS : x ∈ S := Finset.mem_of_mem_erase (hW.2.1 (by simp)) have hpS : p ∈ S := Finset.mem_of_mem_erase (hW.2.1 (by simp)) have hsub : ({x,p} : Finset ℕ) ⊆ S ∩ Finset.Icc x p := by simp only [Finset.insert_subset_iff,Finset.singleton_subset_iff] exact ⟨Finset.mem_inter.mpr ⟨hxS,Finset.mem_Icc.mpr ⟨le_rfl,by omega⟩⟩, Finset.mem_inter.mpr ⟨hpS,Finset.mem_Icc.mpr ⟨by omega,le_rfl⟩⟩⟩ exact (Finset.eq_of_subset_of_card_le hsub (by simpa only [Finset.card_pair (show x ≠ p by omega)] using hcard)).symm end /- OrderedRowCount -/ /- The shift between successive occupied rows in the one-sided interval count. -/ section open Finset theorem ordered_row_sum_le_max_tail (A : Finset ℕ) (H J : ℕ → ℕ) (X : ℕ) : (∀ i ∈ A, J i ≤ X+1) → (∀ i ∈ A, ∀ j ∈ A, i < j → H i+J j ≤ X+1) → ∀ t ∈ A, (∀ i ∈ A, i ≤ t) → (∑ i ∈ A, (H i+J i)) ≤ A.card*(X+1)+H t := by induction A using Finset.induction_on_max with | empty => simp | @insert a A hmax ih => intro hJ hcross t ht htop have haA : a ∉ A := by intro ha; exact (lt_irrefl a) (hmax a ha) have hat : a ≤ t := htop a (Finset.mem_insert_self _ _) have hta : t = a := by rcases Finset.mem_insert.mp ht with heq | htA · exact heq · have hlt := hmax t htA omega subst t by_cases hne : A.Nonempty · let m := A.max' hne have hmA : m ∈ A := Finset.max'_mem A hne have hmmax : ∀ i ∈ A, i ≤ m := fun i hi => Finset.le_max' A i hi have hih := ih (fun i hi => hJ i (Finset.mem_insert_of_mem hi)) (fun i hi j hj hij => hcross i (Finset.mem_insert_of_mem hi) j (Finset.mem_insert_of_mem hj) hij) m hmA hmmax have hstep := hcross m (Finset.mem_insert_of_mem hmA) a (Finset.mem_insert_self _ _) (hmax m hmA) rw [Finset.sum_insert haA,Finset.card_insert_of_notMem haA] nlinarith only [hih,hstep] · have hAempty : A = ∅ := Finset.not_nonempty_iff_eq_empty.mp hne have hJa := hJ a (Finset.mem_insert_self _ _) simpa [hAempty,Nat.add_comm] using Nat.add_le_add_left hJa (H a) theorem ordered_row_sum_le (A : Finset ℕ) (H J : ℕ → ℕ) (X : ℕ) (hH : ∀ i ∈ A, H i ≤ X) (hJ : ∀ i ∈ A, J i ≤ X) (hcross : ∀ i ∈ A, ∀ j ∈ A, i < j → H i+J j ≤ X+1) : (∑ i ∈ A, (H i+J i)) ≤ A.card*(X+1)+X := by by_cases hne : A.Nonempty · let t := A.max' hne have ht : t ∈ A := Finset.max'_mem A hne have hh := ordered_row_sum_le_max_tail A H J X (fun i hi => (hJ i hi).trans (Nat.le_succ X)) hcross t ht (fun i hi => Finset.le_max' A i hi) exact hh.trans (Nat.add_le_add_left (hH t ht) _) · have hz : A = ∅ := Finset.not_nonempty_iff_eq_empty.mp hne simp only [hz,Finset.sum_empty,Finset.card_empty,Nat.zero_mul,Nat.zero_add,Nat.zero_le] theorem ordered_row_total_le {I A : Finset ℕ} (hAI : A ⊆ I) (H J : ℕ → ℕ) (X : ℕ) (hH : ∀ i ∈ A, H i ≤ X) (hJ : ∀ i ∈ A, J i ≤ X) (hcross : ∀ i ∈ A, ∀ j ∈ A, i < j → H i+J j ≤ X+1) (hinactive : ∀ i ∈ I \ A, H i+J i ≤ X) : (∑ i ∈ I, (H i+J i)) ≤ I.card*X+I.card+X := by have hactive := ordered_row_sum_le A H J X hH hJ hcross have hrest : (∑ i ∈ I \ A, (H i+J i)) ≤ (I \ A).card*X := by simpa using Finset.sum_le_sum hinactive have hsum := Finset.sum_sdiff hAI (f := fun i => H i+J i) have hcards := Finset.card_sdiff_add_card_eq_card hAI have hAcard := Finset.card_le_card hAI nlinarith only [hactive,hrest,hsum,hcards,hAcard] end /- IntervalRowLemmas -/ /- Endpoint constraints and private-coordinate counts for the one-sided rows. -/ section open Finset theorem pair_crop_meets_later_interval {S : Finset ℕ} {i p j l : ℕ} (hcrop : S ∩ Finset.Icc i p = {i,p}) (hmet : (S ∩ Finset.Icc j l).Nonempty) (hij : i < j) : p ≤ l := by by_contra hn obtain ⟨z,hz⟩ := hmet obtain ⟨hzS,hzI⟩ := Finset.mem_inter.mp hz obtain ⟨hjz,hzl⟩ := Finset.mem_Icc.mp hzI have hzCrop : z ∈ S ∩ Finset.Icc i p := Finset.mem_inter.mpr ⟨hzS,Finset.mem_Icc.mpr ⟨by omega,by omega⟩⟩ rw [hcrop] at hzCrop simp only [Finset.mem_insert,Finset.mem_singleton] at hzCrop omega theorem crooked_crop_forces_interval_end_lt {S : Finset ℕ} {i p f : ℕ} (hcrooked : IsCrooked (S ∩ Finset.Icc i p)) (hAP : ∃ l : ℕ∞, ((S ∩ Finset.Icc i f : Finset ℕ) : Set ℕ).IsAPOfLength l) : f < p := by by_contra hn have hh := ap_inter_Icc hAP (u := i) (v := p) have heq : (S ∩ Finset.Icc i f) ∩ Finset.Icc i p = S ∩ Finset.Icc i p := by ext x simp only [Finset.mem_inter,Finset.mem_Icc] constructor · rintro ⟨⟨hxS,hix,_hxf⟩,_hix',hxp⟩ exact ⟨hxS,hix,hxp⟩ · rintro ⟨hxS,hix,hxp⟩ exact ⟨⟨hxS,hix,by omega⟩,hix,hxp⟩ rw [heq] at hh exact hcrooked hh theorem witness_row_card_le_interval {N c i u v : ℕ} {F H : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hHF : H ⊆ F) (hc : ∀ S ∈ H, c ∈ S) (p : {S // S ∈ H} → ℕ) (hW : ∀ S, IsWitnessPair S.val c {i,p S}) (hp : ∀ S, p S ∈ Finset.Icc u v) : H.card ≤ (Finset.Icc u v).card := by have hinj : Function.Injective p := by intro S T heq apply Subtype.ext exact (witness_pair_private hF (hHF S.property) (hHF T.property) (hc S.val S.property) (hc T.val T.property) (hW S) (by rw [heq] exact (hW T).2.1.trans (Finset.erase_subset _ _))).symm have hh := Finset.card_le_card_of_injOn p (show Set.MapsTo p ((Finset.univ : Finset {S // S ∈ H}) : Set {S // S ∈ H}) (Finset.Icc u v : Set ℕ) from fun S _hS => hp S) hinj.injOn simpa only [Finset.card_univ,Fintype.card_coe] using hh theorem interval_row_card_le {i u v : ℕ} {E : Finset (Finset ℕ)} (hrep : ∀ S ∈ E, ∃ q ∈ Finset.Icc u v, S = Finset.Icc i q) : E.card ≤ (Finset.Icc u v).card := by have hsub : E ⊆ (Finset.Icc u v).image (fun q => Finset.Icc i q) := by intro S hS obtain ⟨q,hq,hS⟩ := hrep S hS exact Finset.mem_image.mpr ⟨q,hq,hS.symm⟩ exact (Finset.card_le_card hsub).trans Finset.card_image_le theorem three_row_blocks_card_le {A B E N R l m : ℕ} (hRl : R ≤ l) (hlm : l ≤ m) (hmN : m ≤ N+1) (hA : A ≤ l-R) (hE : E ≤ m-l) (hB : B ≤ N+1-m) : A+E+B ≤ N-R+1 := by omega end /- IntervalRowCut -/ /- A row of outside intervals and crooked traces has one common endpoint cutoff. -/ section open Finset theorem bar_and_interval_row_cut {N c j R : ℕ} {F C E : Finset (Finset ℕ)} (hcj : c < j) (hF : Erdos272.IsArithInterSet N F) (hCF : C ⊆ F) (hEF : E ⊆ F) (hc : ∀ S ∈ C, c ∈ S) (p : {S // S ∈ C} → ℕ) (hW : ∀ S, IsWitnessPair S.val c {j,p S}) (hp : ∀ S, R < p S ∧ p S ≤ N) (hCrop : ∀ S, IsCrooked (S.val ∩ Finset.Icc j (p S))) (hrep : ∀ I ∈ E, ∃ f : ℕ, R < f ∧ f ≤ N ∧ I = Finset.Icc j f) (hEne : E.Nonempty) : ∃ l : ℕ, R < l ∧ l ≤ N ∧ (∃ I ∈ E, I = Finset.Icc j l) ∧ C.card+E.card ≤ N-l+1 := by classical let Y := {I // I ∈ E} have hparam : ∀ I : Y, ∃ f : ℕ, R < f ∧ f ≤ N ∧ I.val = Finset.Icc j f := fun I => hrep I.val I.property choose q hRq hqN hqrep using hparam have hY : (Finset.univ : Finset Y).Nonempty := by obtain ⟨I,hI⟩ := hEne exact ⟨⟨I,hI⟩,Finset.mem_univ _⟩ obtain ⟨I₀,_hI₀,hminq⟩ := Finset.exists_min_image Finset.univ q hY let l := q I₀ refine ⟨l,hRq I₀,hqN I₀,⟨I₀.val,I₀.property,hqrep I₀⟩,?_⟩ by_cases hCne : C.Nonempty · have hX : (Finset.univ : Finset {S // S ∈ C}).Nonempty := by obtain ⟨S,hS⟩ := hCne exact ⟨⟨S,hS⟩,Finset.mem_univ _⟩ obtain ⟨K,_hK,hminp⟩ := Finset.exists_min_image Finset.univ p hX let m := p K have hqm : ∀ I : Y, q I < m := by intro I have hcI : c ∉ I.val := by rw [hqrep I] intro hh have hcj' := (Finset.mem_Icc.mp hh).1 omega have hKI : K.val ≠ I.val := by intro heq exact hcI (heq ▸ hc K.val K.property) obtain ⟨t,_ht,hAP⟩ := hF.2 (hCF K.property) (hEF I.property) hKI apply crooked_crop_forces_interval_end_lt (hCrop K) refine ⟨t,?_⟩ simpa only [hqrep I] using hAP have hlm : l < m := hqm I₀ have hmN : m ≤ N := (hp K).2 have hCcard : C.card ≤ (Finset.Icc m N).card := witness_row_card_le_interval hF hCF hc p hW (fun S => Finset.mem_Icc.mpr ⟨hminp S (Finset.mem_univ _),(hp S).2⟩) have hEcard : E.card ≤ (Finset.Icc l (m-1)).card := by apply interval_row_card_le intro I hI let T : Y := ⟨I,hI⟩ exact ⟨q T,Finset.mem_Icc.mpr ⟨hminq T (Finset.mem_univ _),by have hh := hqm T; omega⟩, hqrep T⟩ simp only [Nat.card_Icc] at hCcard hEcard omega · have hCzero : C = ∅ := Finset.not_nonempty_iff_eq_empty.mp hCne have hEcard : E.card ≤ (Finset.Icc l N).card := by apply interval_row_card_le intro I hI let T : Y := ⟨I,hI⟩ exact ⟨q T,Finset.mem_Icc.mpr ⟨hminq T (Finset.mem_univ _),hqN T⟩,hqrep T⟩ have hlN : l ≤ N := hqN I₀ simp only [hCzero,Finset.card_empty,Nat.zero_add] simp only [Nat.card_Icc] at hEcard omega end /- OneSidedRowCount -/ /- The rectangle bound for the right-hand corner witnesses and outside intervals. -/ section open Finset theorem corner_witnesses_and_intervals_card_le {N c L R : ℕ} {F C E : Finset (Finset ℕ)} (hLR : L ≤ R) (hRN : R ≤ N) (hF : Erdos272.IsArithInterSet N F) (hCF : C ⊆ F) (hEF : E ⊆ F) (hc : ∀ S ∈ C, c ∈ S) (x p j q : Finset ℕ → ℕ) (hC : ∀ S ∈ C, c < x S ∧ x S < L ∧ R < p S ∧ p S ≤ N ∧ IsWitnessPair S c {x S,p S} ∧ (S ∩ Finset.Icc (x S) (p S) = {x S,p S} ∨ IsCrooked (S ∩ Finset.Icc (x S) (p S)))) (hE : ∀ S ∈ E, c < j S ∧ j S ≤ L ∧ R < q S ∧ q S ≤ N ∧ S = Finset.Icc (j S) (q S)) : C.card+E.card ≤ (L-c)*(N-R)+2*N := by classical let I := Finset.Ioc c L let HC (i : ℕ) := C.filter (fun S => x S = i) let Hat (i : ℕ) := (HC i).filter (fun S => S ∩ Finset.Icc (x S) (p S) = {x S,p S}) let Bar (i : ℕ) := (HC i).filter (fun S => ¬S ∩ Finset.Icc (x S) (p S) = {x S,p S}) let ER (i : ℕ) := E.filter (fun S => j S = i) let Active := I.filter (fun i => (ER i).Nonempty) have hHCC : ∀ i, HC i ⊆ C := fun i => Finset.filter_subset _ _ have hHatHC : ∀ i, Hat i ⊆ HC i := fun i => Finset.filter_subset _ _ have hBarHC : ∀ i, Bar i ⊆ HC i := fun i => Finset.filter_subset _ _ have hERE : ∀ i, ER i ⊆ E := fun i => Finset.filter_subset _ _ have hHCspec : ∀ i, ∀ S ∈ HC i, R < p S ∧ p S ≤ N ∧ IsWitnessPair S c {i,p S} := by intro i S hS obtain ⟨hSC,hxi⟩ := Finset.mem_filter.mp hS have hh := hC S hSC exact ⟨hh.2.2.1,hh.2.2.2.1,by simpa only [hxi] using hh.2.2.2.2.1⟩ have hHCcard : ∀ i, (HC i).card ≤ N-R := by intro i have hh := witness_row_card_le_interval hF ((hHCC i).trans hCF) (fun S hS => hc S (hHCC i hS)) (fun S => p S.val) (fun S => (hHCspec i S.val S.property).2.2) (fun S => Finset.mem_Icc.mpr ⟨(hHCspec i S.val S.property).1,(hHCspec i S.val S.property).2.1⟩) simpa only [Nat.card_Icc,Nat.succ_eq_add_one,Nat.add_sub_add_right] using hh have hpartition : ∀ i, (Hat i).card+(Bar i).card = (HC i).card := by intro i exact Finset.card_filter_add_card_filter_not (s := HC i) (fun S => S ∩ Finset.Icc (x S) (p S) = {x S,p S}) have hcuts : ∀ i ∈ Active, ∃ l, R < l ∧ l ≤ N ∧ (∃ T ∈ ER i, T = Finset.Icc i l) ∧ (Bar i).card+(ER i).card ≤ N-l+1 := by intro i hi obtain ⟨hiI,hne⟩ := Finset.mem_filter.mp hi have hci : c < i := (Finset.mem_Ioc.mp hiI).1 apply bar_and_interval_row_cut hci hF (((hBarHC i).trans (hHCC i)).trans hCF) ((hERE i).trans hEF) (fun S hS => hc S (hHCC i (hBarHC i hS))) (fun S => p S.val) (fun S => (hHCspec i S.val (hBarHC i S.property)).2.2) (fun S => ⟨(hHCspec i S.val (hBarHC i S.property)).1, (hHCspec i S.val (hBarHC i S.property)).2.1⟩) ?_ ?_ hne · intro S have hSi := hBarHC i S.property have hxi := (Finset.mem_filter.mp hSi).2 have hcases := (hC S.val (hHCC i hSi)).2.2.2.2.2 have hcrooked := hcases.resolve_left (Finset.mem_filter.mp S.property).2 simpa only [hxi] using hcrooked · intro S hS obtain ⟨hSE,hji⟩ := Finset.mem_filter.mp hS have hh := hE S hSE exact ⟨q S,hh.2.2.1,hh.2.2.2.1,by simpa only [hji] using hh.2.2.2.2⟩ have hHat : ∀ i ∈ Active, (Hat i).card ≤ N-R := by intro i _hi exact (Finset.card_le_card (hHatHC i)).trans (hHCcard i) have hBarE : ∀ i ∈ Active, (Bar i).card+(ER i).card ≤ N-R := by intro i hi obtain ⟨l,hRl,hlN,_hT,hcut⟩ := hcuts i hi omega have hcross : ∀ u ∈ Active, ∀ v ∈ Active, u < v → (Hat u).card+((Bar v).card+(ER v).card) ≤ (N-R)+1 := by intro u _hu v hv huv obtain ⟨l,hRl,hlN,⟨T,hT,hTrep⟩,hcut⟩ := hcuts v hv have hHatBound : (Hat u).card ≤ (Finset.Icc (R+1) l).card := by apply witness_row_card_le_interval hF (((hHatHC u).trans (hHCC u)).trans hCF) (fun S hS => hc S (hHCC u (hHatHC u hS))) (fun S => p S.val) (fun S => (hHCspec u S.val (hHatHC u S.property)).2.2) intro S have hSC := hHCC u (hHatHC u S.property) have hxu := (Finset.mem_filter.mp (hHatHC u S.property)).2 have hcrop : S.val ∩ Finset.Icc u (p S.val) = {u,p S.val} := by simpa only [hxu] using (Finset.mem_filter.mp S.property).2 have hmet : (S.val ∩ Finset.Icc v l).Nonempty := by have hh := arithInter_inter_nonempty hF (hCF hSC) (hEF (hERE v hT)) ⟨c,hc S.val hSC⟩ simpa only [hTrep] using hh have hpl := pair_crop_meets_later_interval hcrop hmet huv exact Finset.mem_Icc.mpr ⟨(hHCspec u S.val (hHatHC u S.property)).1,hpl⟩ simp only [Nat.card_Icc,Nat.add_sub_add_right] at hHatBound omega have hinactive : ∀ i ∈ I \ Active, (Hat i).card+((Bar i).card+(ER i).card) ≤ N-R := by intro i hi obtain ⟨hiI,hiA⟩ := Finset.mem_sdiff.mp hi have hnone : ¬(ER i).Nonempty := by intro hn exact hiA (Finset.mem_filter.mpr ⟨hiI,hn⟩) have hz : ER i = ∅ := Finset.not_nonempty_iff_eq_empty.mp hnone have hpart := hpartition i have hbound := hHCcard i simp only [hz,Finset.card_empty] omega have hCmaps : Set.MapsTo x (C : Set (Finset ℕ)) (I : Set ℕ) := by intro S hS have hh := hC S hS exact Finset.mem_Ioc.mpr ⟨hh.1,hh.2.1.le⟩ have hEmaps : Set.MapsTo j (E : Set (Finset ℕ)) (I : Set ℕ) := by intro S hS have hh := hE S hS exact Finset.mem_Ioc.mpr ⟨hh.1,hh.2.1⟩ have hCcount : C.card = ∑ i ∈ I, (HC i).card := Finset.card_eq_sum_card_fiberwise hCmaps have hEcount : E.card = ∑ i ∈ I, (ER i).card := Finset.card_eq_sum_card_fiberwise hEmaps have hsum : (∑ i ∈ I, ((Hat i).card+((Bar i).card+(ER i).card))) = C.card+E.card := by calc _ = ∑ i ∈ I, ((HC i).card+(ER i).card) := by apply Finset.sum_congr rfl intro i _hi have hh := hpartition i omega _ = (∑ i ∈ I, (HC i).card)+(∑ i ∈ I, (ER i).card) := Finset.sum_add_distrib _ = C.card+E.card := by rw [← hCcount,← hEcount] have htotal := ordered_row_total_le (show Active ⊆ I from Finset.filter_subset _ _) (fun i => (Hat i).card) (fun i => (Bar i).card+(ER i).card) (N-R) hHat hBarE hcross hinactive rw [hsum] at htotal have hIcard : I.card = L-c := Nat.card_Ioc c L rw [hIcard] at htotal omega end /- ResidueIntervalCount -/ /- The exact spacing bound for a residue class in an interval. -/ section open Finset theorem residue_interval_card_le {a d u v : ℕ} {S : Finset ℕ} (hsub : S ⊆ Finset.Icc u v) (hmod : ∀ x ∈ S, Nat.ModEq d a x) : S.card ≤ (v-u)/d+1 := by have hmaps : Set.MapsTo (fun x : ℕ => (x-u)/d) (S : Set ℕ) (Finset.range ((v-u)/d+1) : Set ℕ) := by intro x hx have hxv := (Finset.mem_Icc.mp (hsub hx)).2 apply Finset.mem_range.mpr exact Nat.lt_succ_of_le (Nat.div_le_div_right (Nat.sub_le_sub_right hxv u)) have hinj : Set.InjOn (fun x : ℕ => (x-u)/d) (S : Set ℕ) := by intro x hx y hy heq have hux := (Finset.mem_Icc.mp (hsub hx)).1 have huy := (Finset.mem_Icc.mp (hsub hy)).1 have hxy := (hmod x hx).symm.trans (hmod y hy) have hmodsub : Nat.ModEq d (x-u) (y-u) := Nat.ModEq.sub_right hux huy hxy change (x-u)%d = (y-u)%d at hmodsub change (x-u)/d = (y-u)/d at heq have hnx := Nat.mod_add_div (x-u) d have hny := Nat.mod_add_div (y-u) d rw [heq,hmodsub] at hnx omega simpa only [Finset.card_range] using Finset.card_le_card_of_injOn _ hmaps hinj end /- APEndpointRectangle -/ /- Counting a fixed-step progression family by restricted first and last endpoints. -/ section open Finset theorem same_step_endpoint_rectangle_card_le {N L R d : ℕ} {F : Finset (Finset ℕ)} (hd : 0 < d) (hF : Erdos272.IsArithInterSet N F) (hcard : ∀ S ∈ F, 0 < S.card) (hparam : ∀ S ∈ F, ∃ a : ℕ, S = natAP a d S.card ∧ a ≤ L ∧ R ≤ a+(S.card-1)*d) : F.card ≤ (L/d+1)*((N-R)/d+1) := by classical by_cases hne : F.Nonempty · obtain ⟨z,_hzI,hz⟩ := same_step_common_point hd hF hne hcard (fun S hS => by obtain ⟨a,hrep,_ha,_hb⟩ := hparam S hS; exact ⟨a,hrep⟩) let X := {S // S ∈ F} have hp : ∀ S : X, ∃ a : ℕ, S.val = natAP a d S.val.card ∧ a ≤ L ∧ R ≤ a+(S.val.card-1)*d := fun S => hparam S.val S.property choose a hrep haL hRb using hp let b (S : X) := a S+(S.val.card-1)*d have haS : ∀ S : X, a S ∈ S.val := by intro S rw [hrep S] exact mem_natAP.mpr ⟨0,hcard S.val S.property,by simp⟩ have hbS : ∀ S : X, b S ∈ S.val := by intro S rw [hrep S] exact mem_natAP.mpr ⟨S.val.card-1,by have hh := hcard S.val S.property; omega,rfl⟩ have hamod : ∀ S : X, Nat.ModEq d z (a S) := by intro S obtain ⟨i,_hi,hzi⟩ := mem_natAP.mp (hrep S ▸ hz S.val S.property) change z%d = (a S)%d rw [← hzi] simp only [Nat.add_mul_mod_self_right] have hbmod : ∀ S : X, Nat.ModEq d z (b S) := by intro S apply (hamod S).trans change (a S)%d = (a S+(S.val.card-1)*d)%d simp only [Nat.add_mul_mod_self_right] let A := (Finset.univ : Finset X).image a let B := (Finset.univ : Finset X).image b have hAcard : A.card ≤ L/d+1 := by have hh : A.card ≤ (L-1)/d+1 := by apply residue_interval_card_le · intro t ht obtain ⟨S,_hS,rfl⟩ := Finset.mem_image.mp ht have hbnd := Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 S.property) (haS S)) exact Finset.mem_Icc.mpr ⟨hbnd.1,haL S⟩ · intro t ht obtain ⟨S,_hS,rfl⟩ := Finset.mem_image.mp ht exact hamod S have hdiv : (L-1)/d ≤ L/d := Nat.div_le_div_right (Nat.sub_le L 1) omega have hBcard : B.card ≤ (N-R)/d+1 := by apply residue_interval_card_le · intro t ht obtain ⟨S,_hS,rfl⟩ := Finset.mem_image.mp ht have hbnd := Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 S.property) (hbS S)) exact Finset.mem_Icc.mpr ⟨hRb S,hbnd.2⟩ · intro t ht obtain ⟨S,_hS,rfl⟩ := Finset.mem_image.mp ht exact hbmod S let f (S : X) := (a S,b S) have hinj : Function.Injective f := by intro S T heq have ha := congrArg Prod.fst heq have hb := congrArg Prod.snd heq change a S = a T at ha change b S = b T at hb dsimp only [b] at hb rw [ha] at hb have hmul : (S.val.card-1)*d = (T.val.card-1)*d := Nat.add_left_cancel hb have hst := Nat.le_of_mul_le_mul_right hmul.le hd have hts := Nat.le_of_mul_le_mul_right hmul.ge hd have hs := hcard S.val S.property have ht := hcard T.val T.property have hcards : S.val.card = T.val.card := by omega apply Subtype.ext rw [hrep S,hrep T,ha,hcards] have hmaps : Set.MapsTo f ((Finset.univ : Finset X) : Set X) (A.product B : Set (ℕ × ℕ)) := by intro S _hS exact Finset.mem_product.mpr ⟨Finset.mem_image.mpr ⟨S,Finset.mem_univ _,rfl⟩, Finset.mem_image.mpr ⟨S,Finset.mem_univ _,rfl⟩⟩ have hcount : F.card ≤ A.card*B.card := by have hh : F.card ≤ (A.product B).card := by simpa only [Finset.card_univ,X,Fintype.card_coe] using Finset.card_le_card_of_injOn f hmaps hinj.injOn exact hh.trans_eq (Finset.card_product A B) exact hcount.trans (Nat.mul_le_mul hAcard hBcard) · have hz : F = ∅ := Finset.not_nonempty_iff_eq_empty.mp hne simp only [hz,Finset.card_empty,Nat.zero_le] end /- APRectangleSum -/ /- The endpoint-rectangle estimate summed over all steps greater than one. -/ section open Finset theorem same_step_endpoint_rectangle_real_le {N L R d : ℕ} {F : Finset (Finset ℕ)} (hLN : L ≤ N) (hRN : R ≤ N) (hd : 0 < d) (hF : Erdos272.IsArithInterSet N F) (hcard : ∀ S ∈ F, 0 < S.card) (hparam : ∀ S ∈ F, ∃ a : ℕ, S = natAP a d S.card ∧ a ≤ L ∧ R ≤ a+(S.card-1)*d) : (F.card : ℝ) ≤ (L : ℝ)*(N-R)/((d : ℝ)^2)+2*N/d+1 := by have hh := same_step_endpoint_rectangle_card_le hd hF hcard hparam have hhR : (F.card : ℝ) ≤ ((L/d : ℕ)+1 : ℝ)*(((N-R)/d : ℕ)+1 : ℝ) := by exact_mod_cast hh have ha := Nat.cast_div_le (α := ℝ) (m := L) (n := d) have hb := Nat.cast_div_le (α := ℝ) (m := N-R) (n := d) rw [Nat.cast_sub hRN] at hb have hdR : (0 : ℝ) < d := Nat.cast_pos.mpr hd have hRN' : (R : ℝ) ≤ N := by exact_mod_cast hRN have hprod : (F.card : ℝ) ≤ ((L : ℝ)/d+1)*(((N : ℝ)-R)/d+1) := hhR.trans (mul_le_mul (by linarith only [ha]) (by linarith only [hb]) (by positivity) (by positivity)) have hLN' : (L : ℝ) ≤ N := by exact_mod_cast hLN have hsum : ((L : ℝ)+(N-R))/d ≤ 2*N/d := (div_le_div_iff_of_pos_right hdR).mpr (by have := Nat.cast_nonneg (α := ℝ) R; linarith) have hid : ((L : ℝ)/d+1)*(((N : ℝ)-R)/d+1) = (L : ℝ)*(N-R)/((d : ℝ)^2)+((L : ℝ)+(N-R))/d+1 := by ring linarith only [hprod,hsum,hid] theorem large_step_endpoint_rectangle_card_le {N L R : ℕ} {F : Finset (Finset ℕ)} (hLN : L ≤ N) (hRN : R ≤ N) (hF : Erdos272.IsArithInterSet N F) (hcard : ∀ S ∈ F, 0 < S.card) (hparam : ∀ S ∈ F, ∃ a d : ℕ, 2 ≤ d ∧ d ≤ N ∧ S = natAP a d S.card ∧ a ≤ L ∧ R ≤ a+(S.card-1)*d) : (F.card : ℝ) ≤ (2/3)*(L : ℝ)*(N-R)+2*N*reciprocalSum N+N := by classical have hparam' : ∀ S : Finset ℕ, ∃ a d : ℕ, S ∈ F → 2 ≤ d ∧ d ≤ N ∧ S = natAP a d S.card ∧ a ≤ L ∧ R ≤ a+(S.card-1)*d := by intro S by_cases hS : S ∈ F · obtain ⟨a,d,hd,hdN,hrep,ha,hb⟩ := hparam S hS exact ⟨a,d,fun _ => ⟨hd,hdN,hrep,ha,hb⟩⟩ · exact ⟨0,2,fun hh => False.elim (hS hh)⟩ choose a d hspec using hparam' have hmaps : Set.MapsTo d (F : Set (Finset ℕ)) (Finset.Icc 2 N : Set ℕ) := by intro S hS exact Finset.mem_Icc.mpr ⟨(hspec S hS).1,(hspec S hS).2.1⟩ have hsumCard : (F.card : ℝ) = ∑ k ∈ Finset.Icc 2 N, ((F.filter (fun S => d S = k)).card : ℝ) := by exact_mod_cast Finset.card_eq_sum_card_fiberwise hmaps have hbound : ∀ k ∈ Finset.Icc 2 N, ((F.filter (fun S => d S = k)).card : ℝ) ≤ (L : ℝ)*(N-R)/((k : ℝ)^2)+2*N/k+1 := by intro k hk apply same_step_endpoint_rectangle_real_le hLN hRN (by have hh := Finset.mem_Icc.mp hk; omega) (admissible_subfamily hF (Finset.filter_subset _ _)) (fun S hS => hcard S (Finset.mem_filter.mp hS).1) intro S hS obtain ⟨hSF,hdk⟩ := Finset.mem_filter.mp hS exact ⟨a S,by simpa only [hdk] using (hspec S hSF).2.2⟩ have hinv : (∑ k ∈ Finset.Icc 2 N, (k : ℝ)⁻¹) ≤ reciprocalSum N := by apply Finset.sum_le_sum_of_subset_of_nonneg · intro k hk have hh := Finset.mem_Icc.mp hk exact Finset.mem_Icc.mpr ⟨by omega,hh.2⟩ · intro k _hk _hk'; positivity have hcardI : ((Finset.Icc 2 N).card : ℝ) ≤ N := by exact_mod_cast (show (Finset.Icc 2 N).card ≤ N by rw [Nat.card_Icc]; omega) have hsum : (F.card : ℝ) ≤ (L : ℝ)*(N-R)*(∑ k ∈ Finset.Icc 2 N, ((k : ℝ)^2)⁻¹)+ 2*N*(∑ k ∈ Finset.Icc 2 N, (k : ℝ)⁻¹)+(Finset.Icc 2 N).card := by calc (F.card : ℝ) ≤ ∑ k ∈ Finset.Icc 2 N, ((L : ℝ)*(N-R)/((k : ℝ)^2)+2*N/k+1) := by rw [hsumCard] exact Finset.sum_le_sum hbound _ = _ := by simp only [div_eq_mul_inv,Finset.sum_add_distrib,← Finset.mul_sum, Finset.sum_const,nsmul_eq_mul,mul_one] have hRN' : (R : ℝ) ≤ N := by exact_mod_cast hRN have hquad := mul_le_mul_of_nonneg_left (reciprocal_square_tail_two_le N) (show 0 ≤ (L : ℝ)*(N-R) by positivity) have hharm := mul_le_mul_of_nonneg_left hinv (show (0 : ℝ) ≤ 2*N by positivity) linarith only [hsum,hquad,hharm,hcardI] end /- FiniteDensityConvolution -/ /- A finite Dirichlet-convolution identity for the coprime-pair density. -/ section open Finset noncomputable def reciprocalSquareSum (N : ℕ) : ℝ := ∑ d ∈ Finset.Icc 1 N, ((d : ℝ)^2)⁻¹ noncomputable def moebiusSquareSum (N : ℕ) : ℝ := ∑ d ∈ Finset.Icc 1 N, (ArithmeticFunction.moebius d : ℝ)/((d : ℝ)^2) theorem reciprocalSquareSum_bounds {N : ℕ} (hN : 1 ≤ N) : 1 ≤ reciprocalSquareSum N ∧ reciprocalSquareSum N ≤ 5/3 := by refine ⟨?_,reciprocal_square_sum_le N⟩ have hh := Finset.single_le_sum (f := fun d : ℕ => ((d : ℝ)^2)⁻¹) (s := Finset.Icc 1 N) (fun d _hd => by positivity) (show 1 ∈ Finset.Icc 1 N from Finset.mem_Icc.mpr ⟨le_rfl,hN⟩) simpa only [reciprocalSquareSum,Nat.cast_one,one_pow,inv_one] using hh theorem truncated_product_fiber {N n : ℕ} (hn : n ∈ Finset.Icc 1 N) : (((Finset.Icc 1 N).product (Finset.Icc 1 N)).filter (fun p : ℕ × ℕ => p.1*p.2 ≤ N)).filter (fun p => p.1*p.2 = n) = n.divisorsAntidiagonal := by have hn1 := (Finset.mem_Icc.mp hn).1 have hnN := (Finset.mem_Icc.mp hn).2 ext p simp only [Finset.product_eq_sprod,Finset.mem_filter,Finset.mem_product,Finset.mem_Icc, Nat.mem_divisorsAntidiagonal] constructor · rintro ⟨⟨⟨hp,hq⟩,_hprod⟩,heq⟩ exact ⟨heq,by omega⟩ · rintro ⟨heq,_hn0⟩ have hp : 0 < p.1 := by nlinarith only [heq,hn1] have hq : 0 < p.2 := by nlinarith only [heq,hn1] have hpN : p.1 ≤ N := (Nat.le_mul_of_pos_right p.1 hq).trans (heq ▸ hnN) have hqN : p.2 ≤ N := (Nat.le_mul_of_pos_left p.2 hp).trans (heq ▸ hnN) exact ⟨⟨⟨⟨hp,hpN⟩,⟨hq,hqN⟩⟩,heq ▸ hnN⟩,heq⟩ theorem moebius_antidiagonal_weight (n : ℕ) : (∑ p ∈ n.divisorsAntidiagonal, (ArithmeticFunction.moebius p.1 : ℝ)/(((p.1 : ℝ)*p.2)^2)) = if n = 1 then 1 else 0 := by calc _ = ∑ p ∈ n.divisorsAntidiagonal, (ArithmeticFunction.moebius p.1 : ℝ)/((n : ℝ)^2) := by apply Finset.sum_congr rfl intro p hp have heq : (p.1 : ℝ)*p.2 = n := by exact_mod_cast (Nat.mem_divisorsAntidiagonal.mp hp).1 rw [heq] _ = (∑ d ∈ n.divisors, (ArithmeticFunction.moebius d : ℝ))/((n : ℝ)^2) := by rw [Nat.sum_divisorsAntidiagonal (fun d _k => (ArithmeticFunction.moebius d : ℝ)/((n : ℝ)^2)),Finset.sum_div] _ = _ := by have hh : (∑ d ∈ n.divisors, (ArithmeticFunction.moebius d : ℝ)) = if n = 1 then 1 else 0 := by exact_mod_cast moebius_divisor_indicator n rw [hh] split_ifs with hn · subst n; norm_num · simp theorem truncated_moebius_product_sum {N : ℕ} (hN : 1 ≤ N) : (∑ p ∈ ((Finset.Icc 1 N).product (Finset.Icc 1 N)).filter (fun p : ℕ × ℕ => p.1*p.2 ≤ N), (ArithmeticFunction.moebius p.1 : ℝ)/(((p.1 : ℝ)*p.2)^2)) = 1 := by let P := ((Finset.Icc 1 N).product (Finset.Icc 1 N)).filter (fun p : ℕ × ℕ => p.1*p.2 ≤ N) have hmaps : ∀ p ∈ P, p.1*p.2 ∈ Finset.Icc 1 N := by intro p hp obtain ⟨hpI,hprod⟩ := Finset.mem_filter.mp hp obtain ⟨hpi,hqi⟩ := Finset.mem_product.mp hpI exact Finset.mem_Icc.mpr ⟨Nat.mul_pos (Finset.mem_Icc.mp hpi).1 (Finset.mem_Icc.mp hqi).1,hprod⟩ have hsum := Finset.sum_fiberwise_of_maps_to hmaps (fun p : ℕ × ℕ => (ArithmeticFunction.moebius p.1 : ℝ)/(((p.1 : ℝ)*p.2)^2)) calc _ = ∑ n ∈ Finset.Icc 1 N, ∑ p ∈ P.filter (fun p => p.1*p.2 = n), (ArithmeticFunction.moebius p.1 : ℝ)/(((p.1 : ℝ)*p.2)^2) := hsum.symm _ = ∑ n ∈ Finset.Icc 1 N, if n = 1 then (1 : ℝ) else 0 := by apply Finset.sum_congr rfl intro n hn rw [show P.filter (fun p => p.1*p.2 = n) = n.divisorsAntidiagonal from truncated_product_fiber hn,moebius_antidiagonal_weight] _ = 1 := by simp [hN] theorem moebius_product_full_sum (N : ℕ) : (∑ p ∈ (Finset.Icc 1 N).product (Finset.Icc 1 N), (ArithmeticFunction.moebius p.1 : ℝ)/(((p.1 : ℝ)*p.2)^2)) = moebiusSquareSum N*reciprocalSquareSum N := by rw [Finset.product_eq_sprod,Finset.sum_product,moebiusSquareSum,reciprocalSquareSum, Finset.sum_mul] apply Finset.sum_congr rfl intro d _hd rw [Finset.mul_sum] apply Finset.sum_congr rfl intro k _hk simp only [mul_pow,div_eq_mul_inv,mul_inv_rev] ring end /- CoprimeRectangleSieve -/ /- Finite Moebius inversion for coprime pairs in a rectangle. -/ section open Finset def coprimeRectangle (A B : ℕ) : Finset (ℕ × ℕ) := ((Finset.Icc 1 A).product (Finset.Icc 1 B)).filter (fun p => p.1.Coprime p.2) theorem divisors_eq_filter_Icc {m N : ℕ} (hm : 0 < m) (hmN : m ≤ N) : (Finset.Icc 1 N).filter (fun d => d ∣ m) = m.divisors := by ext d simp only [Finset.mem_filter,Finset.mem_Icc,Nat.mem_divisors] constructor · rintro ⟨_hdI,hdm⟩ exact ⟨hdm,hm.ne'⟩ · rintro ⟨hdm,_hm0⟩ exact ⟨⟨Nat.pos_of_dvd_of_pos hdm hm,(Nat.le_of_dvd hm hdm).trans hmN⟩,hdm⟩ theorem coprime_moebius_full_indicator {m N : ℕ} (hm : 0 < m) (hmN : m ≤ N) (j : ℕ) : (∑ d ∈ Finset.Icc 1 N, if d ∣ m ∧ d ∣ j then (ArithmeticFunction.moebius d : ℝ) else 0) = if m.Coprime j then 1 else 0 := by calc _ = ∑ d ∈ (Finset.Icc 1 N).filter (fun d => d ∣ m), if d ∣ j then (ArithmeticFunction.moebius d : ℝ) else 0 := by rw [Finset.sum_filter] apply Finset.sum_congr rfl intro d _hd by_cases hdm : d ∣ m <;> simp [hdm] _ = ∑ d ∈ m.divisors, if d ∣ j then (ArithmeticFunction.moebius d : ℝ) else 0 := by rw [divisors_eq_filter_Icc hm hmN] _ = _ := by exact_mod_cast coprime_moebius_indicator hm j theorem coprimeRectangle_card_moebius {N A B : ℕ} (hAN : A ≤ N) : ((coprimeRectangle A B).card : ℝ) = ∑ d ∈ Finset.Icc 1 N, (ArithmeticFunction.moebius d : ℝ)*(A/d : ℕ)*(B/d : ℕ) := by calc _ = ∑ p ∈ (Finset.Icc 1 A).product (Finset.Icc 1 B), if p.1.Coprime p.2 then (1 : ℝ) else 0 := by simp [coprimeRectangle] _ = ∑ p ∈ (Finset.Icc 1 A).product (Finset.Icc 1 B), ∑ d ∈ Finset.Icc 1 N, if d ∣ p.1 ∧ d ∣ p.2 then (ArithmeticFunction.moebius d : ℝ) else 0 := by apply Finset.sum_congr rfl intro p hp have ha := Finset.mem_Icc.mp (Finset.mem_product.mp hp).1 exact (coprime_moebius_full_indicator ha.1 (ha.2.trans hAN) p.2).symm _ = _ := by rw [Finset.sum_comm] apply Finset.sum_congr rfl intro d _hd have hprod : ((Finset.Icc 1 A).product (Finset.Icc 1 B)).filter (fun p : ℕ × ℕ => d ∣ p.1 ∧ d ∣ p.2) = ((Finset.Icc 1 A).filter (fun a => d ∣ a)).product ((Finset.Icc 1 B).filter (fun b => d ∣ b)) := by ext p simp only [Finset.product_eq_sprod,Finset.mem_filter,Finset.mem_product] tauto rw [← Finset.sum_filter,hprod] simp only [Finset.product_eq_sprod,Finset.sum_const,nsmul_eq_mul,Finset.card_product, card_multiples_Icc,Nat.cast_mul] ring theorem nat_div_product_error {A B d : ℕ} (hd : 0 < d) : |((A/d : ℕ) : ℝ)*(B/d : ℕ)-(A : ℝ)*B/((d : ℝ)^2)| ≤ ((A : ℝ)+B)/d := by have ha := nat_div_error_le_one (K := A) hd have hb := nat_div_error_le_one (K := B) hd have ha0 : (0 : ℝ) ≤ (A/d : ℕ) := Nat.cast_nonneg _ have hb0 : (0 : ℝ) ≤ (B/d : ℕ) := Nat.cast_nonneg _ have hau := Nat.cast_div_le (α := ℝ) (m := A) (n := d) have hbu := Nat.cast_div_le (α := ℝ) (m := B) (n := d) have hda : (0 : ℝ) ≤ (A : ℝ)/d := by positivity have hdb : (0 : ℝ) ≤ (B : ℝ)/d := by positivity have hid : (A : ℝ)*B/((d : ℝ)^2) = ((A : ℝ)/d)*((B : ℝ)/d) := by ring have hsum : ((A : ℝ)+B)/d = (A : ℝ)/d+(B : ℝ)/d := by ring rw [hid,hsum] apply abs_le.mpr have hap := (abs_le.mp ha).1 have hbp := (abs_le.mp hb).1 have hprod := mul_le_mul hau hbu hb0 hda constructor · nlinarith only [hap,hbp,hau,hbu,ha0,hb0,hda,hdb] · nlinarith only [hprod,hda,hdb] end /- FiniteDensityNormalization -/ /- Normalizing the finite coprime density, with an explicit convolution-tail error. -/ section open Finset noncomputable def finiteCoprimeDensity (N : ℕ) : ℝ := (reciprocalSquareSum N)⁻¹ theorem reciprocal_product_row_tail {N a : ℕ} (ha : a ∈ Finset.Icc 1 N) : (∑ k ∈ (Finset.Icc 1 N).filter (fun k => ¬a*k ≤ N), ((k : ℝ)^2)⁻¹) ≤ 2*a/N := by obtain ⟨ha1,haN⟩ := Finset.mem_Icc.mp ha have hN : 0 < N := lt_of_lt_of_le ha1 haN have hdiv : 0 < N/a := Nat.div_pos haN ha1 have hdivN : N/a ≤ N := Nat.div_le_self _ _ have hset : (Finset.Icc 1 N).filter (fun k => ¬a*k ≤ N) = Finset.Ioc (N/a) N := by ext k simp only [Finset.mem_filter,Finset.mem_Icc,Finset.mem_Ioc] have hiff : N/a < k ↔ N < k*a := Nat.div_lt_iff_lt_mul ha1 constructor · rintro ⟨⟨_hk1,hkN⟩,hprod⟩ exact ⟨hiff.mpr (by nlinarith only [hprod]),hkN⟩ · rintro ⟨hk,hkN⟩ exact ⟨⟨by omega,hkN⟩,by have hh := hiff.mp hk; nlinarith only [hh]⟩ rw [hset] have htail := sum_Ioc_inv_sq_le_sub (α := ℝ) (k := N/a) hdiv.ne' hdivN have hrem := Nat.mod_lt N ha1 have hquot := Nat.mod_add_div N a have hmul : N ≤ 2*a*(N/a) := by nlinarith only [hrem,hquot,hdiv] have hmulR : (N : ℝ) ≤ 2*a*(N/a : ℕ) := by exact_mod_cast hmul have hquotR : (0 : ℝ) < (N/a : ℕ) := Nat.cast_pos.mpr hdiv have hNR : (0 : ℝ) < N := Nat.cast_pos.mpr hN have hinv : ((N/a : ℕ) : ℝ)⁻¹ ≤ 2*a/N := by rw [inv_eq_one_div] apply (div_le_div_iff₀ hquotR hNR).mpr simpa only [one_mul] using hmulR have hnonneg : (0 : ℝ) ≤ (N : ℝ)⁻¹ := by positivity linarith only [htail,hinv,hnonneg] theorem reciprocal_product_tail_le {N : ℕ} (hN : 1 ≤ N) : (∑ p ∈ ((Finset.Icc 1 N).product (Finset.Icc 1 N)).filter (fun p : ℕ × ℕ => ¬p.1*p.2 ≤ N), ((p.1 : ℝ)^2)⁻¹*((p.2 : ℝ)^2)⁻¹) ≤ 2*reciprocalSum N/N := by have hsplit : (∑ p ∈ ((Finset.Icc 1 N).product (Finset.Icc 1 N)).filter (fun p : ℕ × ℕ => ¬p.1*p.2 ≤ N), ((p.1 : ℝ)^2)⁻¹*((p.2 : ℝ)^2)⁻¹) = ∑ a ∈ Finset.Icc 1 N, ((a : ℝ)^2)⁻¹* (∑ k ∈ (Finset.Icc 1 N).filter (fun k => ¬a*k ≤ N), ((k : ℝ)^2)⁻¹) := by rw [Finset.sum_filter,Finset.product_eq_sprod,Finset.sum_product] apply Finset.sum_congr rfl intro a _ha simp only [Finset.sum_filter,Finset.mul_sum,mul_ite,mul_zero] rw [hsplit] calc _ ≤ ∑ a ∈ Finset.Icc 1 N, ((a : ℝ)^2)⁻¹*(2*a/N) := by apply Finset.sum_le_sum intro a ha exact mul_le_mul_of_nonneg_left (reciprocal_product_row_tail ha) (by positivity) _ = 2*reciprocalSum N/N := by calc _ = ∑ a ∈ Finset.Icc 1 N, (2/N)*(a : ℝ)⁻¹ := by apply Finset.sum_congr rfl intro a ha have ha0 : (a : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr (by have hh := (Finset.mem_Icc.mp ha).1; omega) have hN0 : (N : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr (by omega) field_simp <;> ring _ = _ := by rw [← Finset.mul_sum]; unfold reciprocalSum; ring theorem moebiusSquareSum_normalization_error {N : ℕ} (hN : 1 ≤ N) : |moebiusSquareSum N*reciprocalSquareSum N-1| ≤ 2*reciprocalSum N/N := by let I := (Finset.Icc 1 N).product (Finset.Icc 1 N) let f (p : ℕ × ℕ) : ℝ := (ArithmeticFunction.moebius p.1 : ℝ)/(((p.1 : ℝ)*p.2)^2) have hgood : (∑ p ∈ I.filter (fun p => p.1*p.2 ≤ N), f p) = 1 := truncated_moebius_product_sum hN have hfull : (∑ p ∈ I, f p) = moebiusSquareSum N*reciprocalSquareSum N := moebius_product_full_sum N have hpart := Finset.sum_filter_add_sum_filter_not I (fun p => p.1*p.2 ≤ N) f have heq : moebiusSquareSum N*reciprocalSquareSum N-1 = ∑ p ∈ I.filter (fun p => ¬p.1*p.2 ≤ N), f p := by linarith only [hpart,hgood,hfull] rw [heq] calc _ ≤ ∑ p ∈ I.filter (fun p => ¬p.1*p.2 ≤ N), |f p| := Finset.abs_sum_le_sum_abs _ _ _ ≤ ∑ p ∈ I.filter (fun p => ¬p.1*p.2 ≤ N), ((p.1 : ℝ)^2)⁻¹*((p.2 : ℝ)^2)⁻¹ := by apply Finset.sum_le_sum intro p _hp have hmu : |(ArithmeticFunction.moebius p.1 : ℝ)| ≤ 1 := by exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := p.1) dsimp only [f] rw [abs_div,abs_of_nonneg (sq_nonneg ((p.1 : ℝ)*p.2))] calc _ ≤ 1/(((p.1 : ℝ)*p.2)^2) := div_le_div_of_nonneg_right hmu (sq_nonneg _) _ = _ := by simp only [mul_pow,one_div,mul_inv_rev]; ring _ ≤ 2*reciprocalSum N/N := reciprocal_product_tail_le hN theorem finiteCoprimeDensity_bounds {N : ℕ} (hN : 1 ≤ N) : 0 < finiteCoprimeDensity N ∧ finiteCoprimeDensity N ≤ 1 := by have hH := (reciprocalSquareSum_bounds hN).1 have hHpos : 0 < reciprocalSquareSum N := by linarith only [hH] refine ⟨inv_pos.mpr hHpos,?_⟩ change (reciprocalSquareSum N)⁻¹ ≤ 1 exact (inv_le_one₀ hHpos).mpr hH theorem moebiusSquareSum_density_error {N : ℕ} (hN : 1 ≤ N) : |moebiusSquareSum N-finiteCoprimeDensity N| ≤ 2*reciprocalSum N/N := by have hH := (reciprocalSquareSum_bounds hN).1 have hHpos : 0 < reciprocalSquareSum N := by linarith only [hH] have hh := moebiusSquareSum_normalization_error hN have hid : |moebiusSquareSum N-finiteCoprimeDensity N| * reciprocalSquareSum N = |moebiusSquareSum N*reciprocalSquareSum N-1| := by rw [← abs_of_pos hHpos,← abs_mul] congr 1 rw [sub_mul] simp only [finiteCoprimeDensity,inv_mul_cancel₀ hHpos.ne',abs_of_pos hHpos] have hnonneg := abs_nonneg (moebiusSquareSum N-finiteCoprimeDensity N) nlinarith only [hh,hid,hH,hnonneg] theorem finiteCoprimeDensity_weights_sum {N : ℕ} (hN : 1 ≤ N) : (∑ d ∈ Finset.Icc 1 N, finiteCoprimeDensity N/((d : ℝ)^2)) = 1 := by rw [show (∑ d ∈ Finset.Icc 1 N, finiteCoprimeDensity N/((d : ℝ)^2)) = finiteCoprimeDensity N*reciprocalSquareSum N by simp only [div_eq_mul_inv,← Finset.mul_sum,reciprocalSquareSum]] have hH := (reciprocalSquareSum_bounds hN).1 exact inv_mul_cancel₀ (by linarith : reciprocalSquareSum N ≠ 0) end /- CoprimeRectangleBounds -/ /- Uniform coprime-rectangle estimates using weights whose finite sum is exactly one. -/ section open Finset theorem coprimeRectangle_moebius_error {N A B : ℕ} (hAN : A ≤ N) : |((coprimeRectangle A B).card : ℝ)-moebiusSquareSum N*A*B| ≤ ((A : ℝ)+B)*reciprocalSum N := by have hmain : moebiusSquareSum N*A*B = ∑ d ∈ Finset.Icc 1 N, (ArithmeticFunction.moebius d : ℝ)*((A : ℝ)*B/((d : ℝ)^2)) := by simp only [moebiusSquareSum,Finset.sum_mul] apply Finset.sum_congr rfl intro d _hd ring have heq : ((coprimeRectangle A B).card : ℝ)-moebiusSquareSum N*A*B = ∑ d ∈ Finset.Icc 1 N, (ArithmeticFunction.moebius d : ℝ)* (((A/d : ℕ) : ℝ)*(B/d : ℕ)-(A : ℝ)*B/((d : ℝ)^2)) := by rw [coprimeRectangle_card_moebius hAN,hmain,← Finset.sum_sub_distrib] apply Finset.sum_congr rfl intro d _hd ring rw [heq] calc _ ≤ ∑ d ∈ Finset.Icc 1 N, |(ArithmeticFunction.moebius d : ℝ)* (((A/d : ℕ) : ℝ)*(B/d : ℕ)-(A : ℝ)*B/((d : ℝ)^2))| := Finset.abs_sum_le_sum_abs _ _ _ ≤ ∑ d ∈ Finset.Icc 1 N, ((A : ℝ)+B)/d := by apply Finset.sum_le_sum intro d hd rw [abs_mul] have hmu : |(ArithmeticFunction.moebius d : ℝ)| ≤ 1 := by exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := d) have herr := nat_div_product_error (A := A) (B := B) (Finset.mem_Icc.mp hd).1 exact (mul_le_mul hmu herr (abs_nonneg _) (by norm_num)).trans (by simp) _ = _ := by simp only [div_eq_mul_inv,← Finset.mul_sum,reciprocalSum] theorem coprimeRectangle_density_error {N A B : ℕ} (hN : 1 ≤ N) (hAN : A ≤ N) (hBN : B ≤ N) : |((coprimeRectangle A B).card : ℝ)-finiteCoprimeDensity N*A*B| ≤ 2*((A : ℝ)+B)*reciprocalSum N := by have hfirst := coprimeRectangle_moebius_error (B := B) hAN have hnormal := moebiusSquareSum_density_error hN have hAN' : (A : ℝ) ≤ N := by exact_mod_cast hAN have hBN' : (B : ℝ) ≤ N := by exact_mod_cast hBN have hNpos : (0 : ℝ) < N := Nat.cast_pos.mpr hN have harea : 2*(A : ℝ)*B ≤ ((A : ℝ)+B)*N := by have ha := mul_nonneg (sub_nonneg.mpr hAN') (Nat.cast_nonneg (α := ℝ) B) have hb := mul_nonneg (sub_nonneg.mpr hBN') (Nat.cast_nonneg (α := ℝ) A) nlinarith only [ha,hb] have hareaDiv : 2*(A : ℝ)*B/N ≤ (A : ℝ)+B := (div_le_iff₀ hNpos).mpr harea have hHnonneg : 0 ≤ reciprocalSum N := Finset.sum_nonneg (fun d _hd => by positivity) have herrorArea : (2*reciprocalSum N/N)*(A : ℝ)*B ≤ ((A : ℝ)+B)*reciprocalSum N := by have hh := mul_le_mul_of_nonneg_right hareaDiv hHnonneg calc _ = (2*(A : ℝ)*B/N)*reciprocalSum N := by ring _ ≤ _ := hh have hsecond : |moebiusSquareSum N*A*B-finiteCoprimeDensity N*A*B| ≤ ((A : ℝ)+B)*reciprocalSum N := by calc _ = |moebiusSquareSum N-finiteCoprimeDensity N| * (A : ℝ)*B := by rw [show moebiusSquareSum N*A*B-finiteCoprimeDensity N*A*B = (moebiusSquareSum N-finiteCoprimeDensity N)*A*B by ring] simp only [abs_mul,Nat.abs_cast] _ ≤ (2*reciprocalSum N/N)*(A : ℝ)*B := by exact mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right hnormal (Nat.cast_nonneg A)) (Nat.cast_nonneg B) _ ≤ _ := herrorArea have hh := abs_sub_le ((coprimeRectangle A B).card : ℝ) (moebiusSquareSum N*A*B) (finiteCoprimeDensity N*A*B) linarith only [hh,hfirst,hsecond] def coprimeBox (A₀ A₁ B₀ B₁ : ℕ) : Finset (ℕ × ℕ) := ((Finset.Ioc A₀ A₁).product (Finset.Ioc B₀ B₁)).filter (fun p => p.1.Coprime p.2) theorem coprimeBox_card_identity {A₀ A₁ B₀ B₁ : ℕ} (hA : A₀ ≤ A₁) (hB : B₀ ≤ B₁) : (coprimeBox A₀ A₁ B₀ B₁).card+(coprimeRectangle A₀ B₁).card+ (coprimeRectangle A₁ B₀).card = (coprimeRectangle A₁ B₁).card+(coprimeRectangle A₀ B₀).card := by let S := (coprimeRectangle A₁ B₁).filter (fun p => ¬p.1 ≤ A₀) let T := (coprimeRectangle A₁ B₀).filter (fun p => ¬p.1 ≤ A₀) have hf₁ : (coprimeRectangle A₁ B₁).filter (fun p => p.1 ≤ A₀) = coprimeRectangle A₀ B₁ := by ext p simp only [coprimeRectangle,Finset.product_eq_sprod,Finset.mem_filter, Finset.mem_product,Finset.mem_Icc] omega have hf₀ : (coprimeRectangle A₁ B₀).filter (fun p => p.1 ≤ A₀) = coprimeRectangle A₀ B₀ := by ext p simp only [coprimeRectangle,Finset.product_eq_sprod,Finset.mem_filter, Finset.mem_product,Finset.mem_Icc] omega have hg₀ : S.filter (fun p => p.2 ≤ B₀) = T := by ext p simp only [S,T,coprimeRectangle,Finset.product_eq_sprod,Finset.mem_filter, Finset.mem_product,Finset.mem_Icc] omega have hg₁ : S.filter (fun p => ¬p.2 ≤ B₀) = coprimeBox A₀ A₁ B₀ B₁ := by ext p simp only [S,coprimeRectangle,coprimeBox,Finset.product_eq_sprod,Finset.mem_filter, Finset.mem_product,Finset.mem_Icc,Finset.mem_Ioc] omega have hp₁ := Finset.card_filter_add_card_filter_not (s := coprimeRectangle A₁ B₁) (fun p => p.1 ≤ A₀) have hp₀ := Finset.card_filter_add_card_filter_not (s := coprimeRectangle A₁ B₀) (fun p => p.1 ≤ A₀) have hpS := Finset.card_filter_add_card_filter_not (s := S) (fun p => p.2 ≤ B₀) rw [hf₁] at hp₁ rw [hf₀] at hp₀ rw [hg₀,hg₁] at hpS change (coprimeRectangle A₀ B₁).card+S.card = _ at hp₁ change (coprimeRectangle A₀ B₀).card+T.card = _ at hp₀ omega theorem coprimeBox_density_error {N A₀ A₁ B₀ B₁ : ℕ} (hN : 1 ≤ N) (hA : A₀ ≤ A₁) (hAN : A₁ ≤ N) (hB : B₀ ≤ B₁) (hBN : B₁ ≤ N) : |((coprimeBox A₀ A₁ B₀ B₁).card : ℝ)- finiteCoprimeDensity N*((A₁ : ℝ)-A₀)*((B₁ : ℝ)-B₀)| ≤ 8*((A₁ : ℝ)+B₁)*reciprocalSum N := by have h₁₁ := coprimeRectangle_density_error hN hAN hBN have h₀₁ := coprimeRectangle_density_error hN (hA.trans hAN) hBN have h₁₀ := coprimeRectangle_density_error hN hAN (hB.trans hBN) have h₀₀ := coprimeRectangle_density_error hN (hA.trans hAN) (hB.trans hBN) have hcard : ((coprimeBox A₀ A₁ B₀ B₁).card : ℝ)+(coprimeRectangle A₀ B₁).card+ (coprimeRectangle A₁ B₀).card = (coprimeRectangle A₁ B₁).card+(coprimeRectangle A₀ B₀).card := by exact_mod_cast coprimeBox_card_identity hA hB have hAR : (A₀ : ℝ) ≤ A₁ := by exact_mod_cast hA have hBR : (B₀ : ℝ) ≤ B₁ := by exact_mod_cast hB have hHnonneg : 0 ≤ reciprocalSum N := Finset.sum_nonneg (fun d _hd => by positivity) have hAH := mul_le_mul_of_nonneg_right hAR hHnonneg have hBH := mul_le_mul_of_nonneg_right hBR hHnonneg obtain ⟨h₁₁l,h₁₁u⟩ := abs_le.mp h₁₁ obtain ⟨h₀₁l,h₀₁u⟩ := abs_le.mp h₀₁ obtain ⟨h₁₀l,h₁₀u⟩ := abs_le.mp h₁₀ obtain ⟨h₀₀l,h₀₀u⟩ := abs_le.mp h₀₀ apply abs_le.mpr constructor <;> nlinarith only [hcard,h₁₁l,h₁₁u,h₀₁l,h₀₁u,h₁₀l,h₁₀u, h₀₀l,h₀₀u,hAH,hBH] end /- PrimitiveTriangleCount -/ /- Counting one orientation of coprime pairs in an interval. -/ section open Finset def coprimeUpperTriangle (A B : ℕ) : Finset (ℕ × ℕ) := (coprimeBox A B A B).filter (fun p => p.1 < p.2) theorem twice_coprimeUpperTriangle_card_le (A B : ℕ) : 2*(coprimeUpperTriangle A B).card ≤ (coprimeBox A B A B).card := by classical let T := coprimeUpperTriangle A B have hinj : Function.Injective (Prod.swap : ℕ × ℕ → ℕ × ℕ) := Prod.swap_injective have hdis : Disjoint T (T.image Prod.swap) := by apply Finset.disjoint_left.mpr intro p hp hp' obtain ⟨q,hq,hqp⟩ := Finset.mem_image.mp hp' have hltp := (Finset.mem_filter.mp hp).2 have hltq := (Finset.mem_filter.mp hq).2 have hfst := congrArg Prod.fst hqp have hsnd := congrArg Prod.snd hqp change q.2 = p.1 at hfst change q.1 = p.2 at hsnd omega have hsub : T ∪ T.image Prod.swap ⊆ coprimeBox A B A B := by intro p hp rcases Finset.mem_union.mp hp with hp | hp · exact (Finset.mem_filter.mp hp).1 · obtain ⟨q,hq,rfl⟩ := Finset.mem_image.mp hp obtain ⟨hqi,hcop⟩ := Finset.mem_filter.mp (Finset.mem_filter.mp hq).1 have hqI := Finset.mem_product.mp hqi exact Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨hqI.2,hqI.1⟩,hcop.symm⟩ have hh := Finset.card_le_card hsub rw [Finset.card_union_of_disjoint hdis,Finset.card_image_of_injective _ hinj] at hh dsimp only [T] at hh omega theorem coprimeUpperTriangle_card_le {N A B : ℕ} (hN : 1 ≤ N) (hAB : A ≤ B) (hBN : B ≤ N) : ((coprimeUpperTriangle A B).card : ℝ) ≤ finiteCoprimeDensity N*((B : ℝ)-A)^2/2+8*B*reciprocalSum N := by have htwice : 2*((coprimeUpperTriangle A B).card : ℝ) ≤ (coprimeBox A B A B).card := by exact_mod_cast twice_coprimeUpperTriangle_card_le A B have hbox := (abs_le.mp (coprimeBox_density_error hN hAB hBN hAB hBN)).2 nlinarith only [htwice,hbox] end /- AbstractMiddleCount -/ /- A progression-endpoint rectangle and primitive witnesses in the middle region. -/ section open Finset theorem middle_coordinate_pools_card_le {N C A e M : ℕ} {E Wm Wp : Finset (ℕ × ℕ)} (hN : 1 ≤ N) (hCN : C ≤ N) (hAe : A ≤ e) (heM : e ≤ M) (hMN : M ≤ N) (hE : E ⊆ (Finset.Icc 1 C).product (Finset.Ioc A e)) (hWm : Wm ⊆ coprimeBox 0 C A M) (hdis : Disjoint E Wm) (hWp : ∀ p ∈ Wp, 1 ≤ p.1 ∧ p.1 < p.2 ∧ e < p.2 ∧ p.2 ≤ M ∧ p.1.Coprime p.2) : (E.card : ℝ)+Wm.card+Wp.card ≤ (C : ℝ)*((e : ℝ)-A)+ finiteCoprimeDensity N*(((M : ℝ)-e)*(C+M)-((M : ℝ)-e)^2/2)+ 40*((C : ℝ)+M)*reciprocalSum N := by classical let W₀ := Wm.filter (fun p => p.2 ≤ e) let W₁ := Wm.filter (fun p => ¬p.2 ≤ e) let V₀ := Wp.filter (fun p => p.1 ≤ e) let V₁ := Wp.filter (fun p => ¬p.1 ≤ e) have hW₀ : W₀ ⊆ (Finset.Icc 1 C).product (Finset.Ioc A e) := by intro p hp obtain ⟨hpW,hpe⟩ := Finset.mem_filter.mp hp obtain ⟨hpI,_hcop⟩ := Finset.mem_filter.mp (hWm hpW) obtain ⟨hp₁,hp₂⟩ := Finset.mem_product.mp hpI obtain ⟨hp₁0,hp₁C⟩ := Finset.mem_Ioc.mp hp₁ obtain ⟨hp₂A,_hp₂M⟩ := Finset.mem_Ioc.mp hp₂ exact Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨hp₁0,hp₁C⟩, Finset.mem_Ioc.mpr ⟨hp₂A,hpe⟩⟩ have hW₁ : W₁ ⊆ coprimeBox 0 C e M := by intro p hp obtain ⟨hpW,hpe⟩ := Finset.mem_filter.mp hp obtain ⟨hpI,hcop⟩ := Finset.mem_filter.mp (hWm hpW) obtain ⟨hp₁,hp₂⟩ := Finset.mem_product.mp hpI have hp₂M := (Finset.mem_Ioc.mp hp₂).2 exact Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨hp₁, Finset.mem_Ioc.mpr ⟨by omega,hp₂M⟩⟩,hcop⟩ have hV₀ : V₀ ⊆ coprimeBox 0 e e M := by intro p hp obtain ⟨hpV,hpe⟩ := Finset.mem_filter.mp hp obtain ⟨hp₁,hlt,hp₂e,hp₂M,hcop⟩ := hWp p hpV exact Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨Finset.mem_Ioc.mpr ⟨hp₁,hpe⟩,Finset.mem_Ioc.mpr ⟨hp₂e,hp₂M⟩⟩,hcop⟩ have hV₁ : V₁ ⊆ coprimeUpperTriangle e M := by intro p hp obtain ⟨hpV,hpe⟩ := Finset.mem_filter.mp hp obtain ⟨_hp₁,hlt,hp₂e,hp₂M,hcop⟩ := hWp p hpV exact Finset.mem_filter.mpr ⟨Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨Finset.mem_Ioc.mpr ⟨by omega,by omega⟩,Finset.mem_Ioc.mpr ⟨hp₂e,hp₂M⟩⟩,hcop⟩,hlt⟩ have hrect : (E.card : ℝ)+W₀.card ≤ (C : ℝ)*((e : ℝ)-A) := by have hdis₀ : Disjoint E W₀ := hdis.mono_right (Finset.filter_subset _ _) have hsub := Finset.union_subset hE hW₀ have hh := Finset.card_le_card hsub rw [Finset.card_union_of_disjoint hdis₀] at hh have hh' : E.card+W₀.card ≤ C*(e-A) := by simpa only [Finset.product_eq_sprod,Finset.card_product,Nat.card_Icc, Nat.card_Ioc,Nat.add_sub_cancel] using hh have hhR : (E.card : ℝ)+W₀.card ≤ (C : ℝ)*(e-A : ℕ) := by exact_mod_cast hh' simpa only [Nat.cast_sub hAe] using hhR have hwm : (W₁.card : ℝ) ≤ finiteCoprimeDensity N*C*((M : ℝ)-e)+ 8*((C : ℝ)+M)*reciprocalSum N := by have hcard : (W₁.card : ℝ) ≤ (coprimeBox 0 C e M).card := by exact_mod_cast Finset.card_le_card hW₁ have hh := (abs_le.mp (coprimeBox_density_error hN (Nat.zero_le C) hCN heM hMN)).2 norm_num only [Nat.cast_zero,sub_zero] at hh linarith only [hcard,hh] have hv₀ : (V₀.card : ℝ) ≤ finiteCoprimeDensity N*e*((M : ℝ)-e)+ 8*((e : ℝ)+M)*reciprocalSum N := by have hcard : (V₀.card : ℝ) ≤ (coprimeBox 0 e e M).card := by exact_mod_cast Finset.card_le_card hV₀ have hh := (abs_le.mp (coprimeBox_density_error hN (Nat.zero_le e) (heM.trans hMN) heM hMN)).2 norm_num only [Nat.cast_zero,sub_zero] at hh linarith only [hcard,hh] have hv₁ : (V₁.card : ℝ) ≤ finiteCoprimeDensity N*((M : ℝ)-e)^2/2+ 8*M*reciprocalSum N := by have hcard : (V₁.card : ℝ) ≤ (coprimeUpperTriangle e M).card := by exact_mod_cast Finset.card_le_card hV₁ exact hcard.trans (coprimeUpperTriangle_card_le hN heM hMN) have hwpart : (W₀.card : ℝ)+W₁.card = Wm.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := Wm) (fun p => p.2 ≤ e) have hvpart : (V₀.card : ℝ)+V₁.card = Wp.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := Wp) (fun p => p.1 ≤ e) have hH : 0 ≤ reciprocalSum N := Finset.sum_nonneg (fun d _hd => by positivity) have heR : (e : ℝ) ≤ M := by exact_mod_cast heM have heH := mul_le_mul_of_nonneg_right heR hH have hCH := mul_nonneg (Nat.cast_nonneg (α := ℝ) C) hH have hMH := mul_nonneg (Nat.cast_nonneg (α := ℝ) M) hH nlinarith only [hrect,hwm,hv₀,hv₁,hwpart,hvpart,heH,hCH,hMH] end /- CenteredEndpointMembership -/ /- Natural-coordinate endpoints and internal points of a centered progression. -/ section open Finset theorem centered_model_positive_mem {c d k : ℕ} {p : ProgressionCell} {S : Finset ℕ} (hmodel : IsCenteredModel c d p S) (hk : k ≤ p.val.2) : c+k*d ∈ S := by have hh := (centered_point_mem hmodel (z := (k : ℤ)) (Finset.mem_Icc.mpr ⟨by omega,by exact_mod_cast hk⟩)).1 have heq : ((c : ℤ)+(d : ℤ)*k).toNat = c+k*d := by rw [show (c : ℤ)+(d : ℤ)*k = ((c+k*d : ℕ) : ℤ) by push_cast; ring] exact Int.toNat_natCast _ simpa only [heq] using hh theorem centered_model_negative_mem {c d k : ℕ} {p : ProgressionCell} {S : Finset ℕ} (hmodel : IsCenteredModel c d p S) (hk : k ≤ p.val.1) : c-k*d ∈ S := by have hh := (centered_point_mem hmodel (z := -(k : ℤ)) (Finset.mem_Icc.mpr ⟨by omega,by omega⟩)).1 have heq : ((c : ℤ)+(d : ℤ)*(-(k : ℤ))).toNat = c-k*d := by rw [show (c : ℤ)+(d : ℤ)*(-(k : ℤ)) = (c : ℤ)-(k*d : ℕ) by push_cast; ring] omega simpa only [heq] using hh theorem centered_model_root_mem {c d : ℕ} {p : ProgressionCell} {S : Finset ℕ} (hmodel : IsCenteredModel c d p S) : c ∈ S := by simpa only [Nat.zero_mul,Nat.add_zero] using centered_model_positive_mem hmodel (Nat.zero_le p.val.2) end /- MiddleStepCoordinates -/ /- The middle-region estimate for one progression step, in centered integer coordinates. -/ section open Finset theorem middle_step_coordinate_bound {N c d C A M : ℕ} {F Cm Cp E : Finset (Finset ℕ)} (hN : 1 ≤ N) (hCN : C ≤ N) (hAM : A ≤ M) (hMN : M ≤ N) (hF : Erdos272.IsArithInterSet N F) (hMF : Cm ⊆ F) (hPF : Cp ⊆ F) (hEF : E ⊆ F) (hcM : ∀ S ∈ Cm, c ∈ S) (hcP : ∀ S ∈ Cp, c ∈ S) (hcrookedM : ∀ S ∈ Cm, IsCrooked S) (hcrookedP : ∀ S ∈ Cp, IsCrooked S) (m : {S // S ∈ Cm} → ℕ × ℕ) (p : {S // S ∈ Cp} → ℕ × ℕ) (model : {S // S ∈ E} → ProgressionCell) (hm : ∀ S, 1 ≤ (m S).1 ∧ (m S).1 ≤ C ∧ A < (m S).2 ∧ (m S).2 ≤ M ∧ (m S).1.Coprime (m S).2 ∧ IsWitnessPair S.val c {c-(m S).1*d,c+(m S).2*d}) (hp : ∀ S, 1 ≤ (p S).1 ∧ (p S).1 < (p S).2 ∧ A < (p S).2 ∧ (p S).2 ≤ M ∧ (p S).1.Coprime (p S).2 ∧ IsWitnessPair S.val c {c+(p S).1*d,c+(p S).2*d}) (hmodel : ∀ T, IsCenteredModel c d (model T) T.val ∧ 1 ≤ (model T).val.1 ∧ (model T).val.1 ≤ C ∧ A < (model T).val.2 ∧ (model T).val.2 ≤ M ∧ ∃ l : ℕ∞, (T.val : Set ℕ).IsAPOfLength l) : ∃ e : ℕ, A ≤ e ∧ e ≤ M ∧ (Cm.card : ℝ)+Cp.card+E.card ≤ (C : ℝ)*((e : ℝ)-A)+ finiteCoprimeDensity N*(((M : ℝ)-e)*(C+M)-((M : ℝ)-e)^2/2)+ 40*((C : ℝ)+M)*reciprocalSum N := by classical let X := {S // S ∈ Cm} let Y := {S // S ∈ Cp} let Z := {S // S ∈ E} let fE (T : Z) := (model T).val let Wm := (Finset.univ : Finset X).image m let Wp := (Finset.univ : Finset Y).image p let EE := (Finset.univ : Finset Z).image fE have hm_inj : Function.Injective m := by intro S T heq apply Subtype.ext have hwS := (hm S).2.2.2.2.2 have hwT := (hm T).2.2.2.2.2 exact (witness_pair_private hF (hMF S.property) (hMF T.property) (hcM S.val S.property) (hcM T.val T.property) hwS (by rw [heq] exact hwT.2.1.trans (Finset.erase_subset _ _))).symm have hp_inj : Function.Injective p := by intro S T heq apply Subtype.ext have hwS := (hp S).2.2.2.2.2 have hwT := (hp T).2.2.2.2.2 exact (witness_pair_private hF (hPF S.property) (hPF T.property) (hcP S.val S.property) (hcP T.val T.property) hwS (by rw [heq] exact hwT.2.1.trans (Finset.erase_subset _ _))).symm have he_inj : Function.Injective fE := by intro S T heq have hmod : model S = model T := Subtype.ext heq apply Subtype.ext exact centered_model_determines_set (hmodel S).1 (by simpa only [hmod] using (hmodel T).1) have hwm_card : Wm.card = Cm.card := by simp only [Wm,Finset.card_image_of_injective _ hm_inj,Finset.card_univ,X,Fintype.card_coe] have hwp_card : Wp.card = Cp.card := by simp only [Wp,Finset.card_image_of_injective _ hp_inj,Finset.card_univ,Y,Fintype.card_coe] have he_card : EE.card = E.card := by simp only [EE,Finset.card_image_of_injective _ he_inj,Finset.card_univ,Z,Fintype.card_coe] have he_exists : ∃ e : ℕ, A ≤ e ∧ e ≤ M ∧ (∀ T : Z, (model T).val.2 ≤ e) ∧ (e = A ∨ ∃ T : Z, (model T).val.2 = e) := by by_cases hne : E.Nonempty · have hz : (Finset.univ : Finset Z).Nonempty := by obtain ⟨T,hT⟩ := hne exact ⟨⟨T,hT⟩,Finset.mem_univ _⟩ obtain ⟨T,_hT,hmax⟩ := Finset.exists_max_image Finset.univ (fun T : Z => (model T).val.2) hz refine ⟨(model T).val.2,(hmodel T).2.2.2.1.le,(hmodel T).2.2.2.2.1, fun S => hmax S (Finset.mem_univ _),Or.inr ⟨T,rfl⟩⟩ · refine ⟨A,le_rfl,hAM,?_,Or.inl rfl⟩ intro T exact False.elim (hne ⟨T.val,T.property⟩) obtain ⟨e,hAe,heM,hmax,hewitness⟩ := he_exists have hErect : EE ⊆ (Finset.Icc 1 C).product (Finset.Ioc A e) := by intro q hq obtain ⟨T,_hT,rfl⟩ := Finset.mem_image.mp hq exact Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨(hmodel T).2.1,(hmodel T).2.2.1⟩, Finset.mem_Ioc.mpr ⟨(hmodel T).2.2.2.1,hmax T⟩⟩ have hWmBox : Wm ⊆ coprimeBox 0 C A M := by intro q hq obtain ⟨S,_hS,rfl⟩ := Finset.mem_image.mp hq exact Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨Finset.mem_Ioc.mpr ⟨(hm S).1,(hm S).2.1⟩, Finset.mem_Ioc.mpr ⟨(hm S).2.2.1,(hm S).2.2.2.1⟩⟩,(hm S).2.2.2.2.1⟩ have hdis : Disjoint EE Wm := by apply Finset.disjoint_left.mpr intro q hqE hqW obtain ⟨T,_hT,rfl⟩ := Finset.mem_image.mp hqE obtain ⟨S,_hS,hcoords⟩ := Finset.mem_image.mp hqW have hmT := (hmodel T).1 apply witness_pair_not_subset_AP_member hF (hMF S.property) (hEF T.property) (hcM S.val S.property) (centered_model_root_mem hmT) (hcrookedM S.val S.property) (hmodel T).2.2.2.2.2 (hm S).2.2.2.2.2 change m S = (model T).val at hcoords rw [hcoords] exact Finset.insert_subset_iff.mpr ⟨centered_model_negative_mem hmT le_rfl, Finset.singleton_subset_iff.mpr (centered_model_positive_mem hmT le_rfl)⟩ have hWpAbove : ∀ q ∈ Wp, 1 ≤ q.1 ∧ q.1 < q.2 ∧ e < q.2 ∧ q.2 ≤ M ∧ q.1.Coprime q.2 := by intro q hq obtain ⟨S,_hS,rfl⟩ := Finset.mem_image.mp hq refine ⟨(hp S).1,(hp S).2.1,?_,(hp S).2.2.2.1,(hp S).2.2.2.2.1⟩ by_contra hn have hbe : (p S).2 ≤ e := by omega rcases hewitness with he | ⟨T,hTe⟩ · have hh := (hp S).2.2.1 omega · have hmT := (hmodel T).1 have ha : (p S).1 ≤ (model T).val.2 := by have hab := (hp S).2.1 omega have hb : (p S).2 ≤ (model T).val.2 := by omega apply witness_pair_not_subset_AP_member hF (hPF S.property) (hEF T.property) (hcP S.val S.property) (centered_model_root_mem hmT) (hcrookedP S.val S.property) (hmodel T).2.2.2.2.2 (hp S).2.2.2.2.2 exact Finset.insert_subset_iff.mpr ⟨centered_model_positive_mem hmT ha, Finset.singleton_subset_iff.mpr (centered_model_positive_mem hmT hb)⟩ have hh := middle_coordinate_pools_card_le hN hCN hAe heM hMN hErect hWmBox hdis hWpAbove rw [hwm_card,hwp_card,he_card] at hh exact ⟨e,hAe,heM,by linarith only [hh]⟩ end /- MiddleScalingAlgebra -/ /- Converting the centered-grid estimate to physical endpoint lengths. -/ section theorem middle_grid_scaling {n c r R d C A M e ρ H K : ℝ} (hn : 0 ≤ n) (hc : 0 ≤ c) (hcN : c ≤ n) (hr : 0 ≤ r) (hR : 0 ≤ R) (hRN : R ≤ n) (hd : 0 < d) (hC : 0 ≤ C) (hA : 0 ≤ A) (hAe : A ≤ e) (heM : e ≤ M) (hCd : C*d ≤ c) (hCMd : (C+M)*d ≤ R) (hwidth : (M-A)*d ≤ r+d) (hρ : 0 ≤ ρ) (hρ1 : ρ ≤ 1) (hH : 0 ≤ H) (hK : K ≤ C*(e-A)+ρ*((M-e)*(C+M)-(M-e)^2/2)+40*(C+M)*H) : ∃ s : ℝ, 0 ≤ s ∧ s ≤ r ∧ K ≤ (c*(r-s)+ρ*(s*R-s^2/2))/d^2+(40*H+2)*n/d := by let u := (M-e)*d let s := min r u have hu : 0 ≤ u := mul_nonneg (sub_nonneg.mpr heM) hd.le have hs : 0 ≤ s := le_min hr hu have hsr : s ≤ r := min_le_left _ _ have hsu : s ≤ u := min_le_right _ _ have huwidth : u ≤ r+d := by dsimp only [u]; nlinarith only [hwidth,hAe,hd] have hdelta : u-s ≤ d := by dsimp only [s] rcases le_total r u with hru | hur · rw [min_eq_left hru]; linarith only [huwidth] · rw [min_eq_right hur]; linarith only [hd] have hstart0 : 0 ≤ (e-A)*d := mul_nonneg (sub_nonneg.mpr hAe) hd.le have hstart : (e-A)*d ≤ r-s+d := by have hsum : (e-A)*d+u = (M-A)*d := by dsimp only [u]; ring linarith only [hwidth,hsum,hsu] have hfirst : (C*d)*((e-A)*d) ≤ c*(r-s+d) := by exact (mul_le_mul_of_nonneg_right hCd hstart0).trans (mul_le_mul_of_nonneg_left hstart hc) have hright : u*((C+M)*d) ≤ u*R := mul_le_mul_of_nonneg_left hCMd hu have htail₁ : ρ*(u*((C+M)*d)-u^2/2) ≤ ρ*(u*R-u^2/2) := mul_le_mul_of_nonneg_left (by linarith only [hright]) hρ have hdeltaR := mul_le_mul_of_nonneg_right hdelta hR have hdeltaSum : 0 ≤ (u-s)*(u+s) := mul_nonneg (sub_nonneg.mpr hsu) (add_nonneg hu hs) have htail₂ : u*R-u^2/2 ≤ s*R-s^2/2+d*R := by nlinarith only [hdeltaR,hdeltaSum] have hρdR := mul_le_mul_of_nonneg_right hρ1 (mul_nonneg hd.le hR) have htail₃ : ρ*(u*R-u^2/2) ≤ ρ*(s*R-s^2/2)+d*R := by have hh := mul_le_mul_of_nonneg_left htail₂ hρ nlinarith only [hh,hρdR] have hgrid : (C*(e-A)+ρ*((M-e)*(C+M)-(M-e)^2/2))*d^2 ≤ c*(r-s)+ρ*(s*R-s^2/2)+d*(c+R) := by dsimp only [u] at htail₁ htail₃ nlinarith only [hfirst,htail₁,htail₃] have hCMN : (C+M)*d ≤ n := hCMd.trans hRN have herr := mul_le_mul_of_nonneg_right hCMN (show 0 ≤ 40*H*d by positivity) have hends := mul_le_mul_of_nonneg_left (add_le_add hcN hRN) hd.le have hKd := mul_le_mul_of_nonneg_right hK (sq_nonneg d) have hscaled : K*d^2 ≤ c*(r-s)+ρ*(s*R-s^2/2)+(40*H+2)*n*d := by nlinarith only [hKd,hgrid,herr,hends] refine ⟨s,hs,hsr,?_⟩ have hid : ((c*(r-s)+ρ*(s*R-s^2/2))/d^2+(40*H+2)*n/d)*d^2 = c*(r-s)+ρ*(s*R-s^2/2)+(40*H+2)*n*d := by field_simp <;> ring exact (mul_le_mul_iff_of_pos_right (sq_pos_of_pos hd)).mp (by rw [hid] exact hscaled) theorem middle_nat_grid_bounds {N c L R d : ℕ} (hcL : c ≤ L) (hLR : L ≤ R) (hd : 0 < d) : ((c/d : ℕ) : ℝ)*d ≤ c ∧ (((c/d : ℕ) : ℝ)+( (R-c)/d : ℕ))*d ≤ R ∧ ((( (R-c)/d : ℕ) : ℝ)-((L-c)/d : ℕ))*d ≤ ((R : ℝ)-L)+d := by have hcR : c ≤ R := hcL.trans hLR have hcdiv := Nat.div_mul_le_self c d have hRdiv := Nat.div_mul_le_self (R-c) d have hLmod := Nat.mod_lt (L-c) hd have hLquot := Nat.mod_add_div (L-c) d have hLdiv : L-c ≤ ((L-c)/d+1)*d := by nlinarith only [hLmod,hLquot] have hcdivR : ((c/d : ℕ) : ℝ)*d ≤ c := by exact_mod_cast hcdiv have hRdivR : (((R-c)/d : ℕ) : ℝ)*d ≤ (R : ℝ)-c := by exact_mod_cast hRdiv have hLdivR : (L : ℝ)-c ≤ (((L-c)/d : ℕ)+1 : ℝ)*d := by exact_mod_cast hLdiv exact ⟨hcdivR,by nlinarith only [hcdivR,hRdivR],by nlinarith only [hRdivR,hLdivR]⟩ theorem middle_nat_grid_scale {N c L R d e : ℕ} {K : ℝ} (hN : 1 ≤ N) (hcL : c ≤ L) (hLR : L ≤ R) (hRN : R ≤ N) (hd : 0 < d) (hAe : (L-c)/d ≤ e) (heM : e ≤ (R-c)/d) (hK : K ≤ ((c/d : ℕ) : ℝ)*((e : ℝ)-((L-c)/d : ℕ))+ finiteCoprimeDensity N*((((R-c)/d : ℕ)-(e : ℝ))*((c/d : ℕ)+((R-c)/d : ℕ) : ℝ)- (((R-c)/d : ℕ)-(e : ℝ))^2/2)+ 40*((c/d : ℕ)+((R-c)/d : ℕ) : ℝ)*reciprocalSum N) : ∃ s : ℝ, 0 ≤ s ∧ s ≤ (R : ℝ)-L ∧ K ≤ ((c : ℝ)*((R : ℝ)-L-s)+finiteCoprimeDensity N*(s*R-s^2/2))/((d : ℝ)^2)+ (40*reciprocalSum N+2)*N/d := by have hcN : c ≤ N := hcL.trans (hLR.trans hRN) have hb := middle_nat_grid_bounds (N := N) hcL hLR hd apply middle_grid_scaling (Nat.cast_nonneg N) (Nat.cast_nonneg c) (by exact_mod_cast hcN) (sub_nonneg.mpr (by exact_mod_cast hLR)) (Nat.cast_nonneg R) (by exact_mod_cast hRN) (Nat.cast_pos.mpr hd) (Nat.cast_nonneg (c/d)) (Nat.cast_nonneg ((L-c)/d)) (by exact_mod_cast hAe) (by exact_mod_cast heM) hb.1 hb.2.1 hb.2.2 (finiteCoprimeDensity_bounds hN).1.le (finiteCoprimeDensity_bounds hN).2 (Finset.sum_nonneg (fun d _hd => by positivity)) hK end /- WeightedMiddleDeficit -/ /- Summing the normalized middle-region estimates while retaining the endpoint deficit. -/ section open Finset theorem finiteCoprimeDensity_mul_five_thirds {N : ℕ} (hN : 1 ≤ N) : 1 ≤ finiteCoprimeDensity N*(5/3) := by have hH := reciprocalSquareSum_bounds hN have hρ := (finiteCoprimeDensity_bounds hN).1 have hid : finiteCoprimeDensity N*reciprocalSquareSum N = 1 := inv_mul_cancel₀ (by linarith only [hH.1] : reciprocalSquareSum N ≠ 0) have hh := mul_le_mul_of_nonneg_left hH.2 hρ.le linarith only [hid,hh] theorem weighted_middle_deficit {N c L R : ℕ} (hN : 1 ≤ N) (hcL : c ≤ L) (hLR : L ≤ R) (hRN : R ≤ N) (s : ℕ → ℝ) (hs : ∀ d ∈ Finset.Icc 1 N, 0 ≤ s d ∧ s d ≤ (R : ℝ)-L) : (5/3)*(L : ℝ)*(N-R)+((R : ℝ)-L)*(N-R)+ (∑ d ∈ Finset.Icc 1 N, ((c : ℝ)*((R : ℝ)-L-s d)+finiteCoprimeDensity N*(s d*R-(s d)^2/2))/((d : ℝ)^2)) ≤ (N : ℝ)^2/2-((L : ℝ)^2+((N : ℝ)-R)^2)/100 := by let Outer := (5/3)*(L : ℝ)*(N-R)+((R : ℝ)-L)*(N-R) let Bound := (N : ℝ)^2/2-((L : ℝ)^2+((N : ℝ)-R)^2)/100 let w (d : ℕ) := finiteCoprimeDensity N/((d : ℝ)^2) let f (d : ℕ) := ((c : ℝ)*((R : ℝ)-L-s d)+ finiteCoprimeDensity N*(s d*R-(s d)^2/2))/((d : ℝ)^2) have hρ := (finiteCoprimeDensity_bounds hN).1 have hρk := finiteCoprimeDensity_mul_five_thirds hN have hcLR : (c : ℝ) ≤ L := by exact_mod_cast hcL have hRNR : (R : ℝ) ≤ N := by exact_mod_cast hRN have hterms : ∀ d ∈ Finset.Icc 1 N, w d*Outer+f d ≤ w d*Bound := by intro d hd have hsd := (hs d hd).2 have hretained := retained_deficit (n := (N : ℝ)) (q := (L : ℝ)-c) (c := (c : ℝ)) (r := (R : ℝ)-L) (x := (N : ℝ)-R) (s := s d) (k := 5/3) (sub_nonneg.mpr hcLR) (Nat.cast_nonneg c) (sub_nonneg.mpr hRNR) hsd (by norm_num) le_rfl (by ring) have hweighted := mul_le_mul_of_nonneg_left hretained hρ.le have hcz : 0 ≤ (c : ℝ)*((R : ℝ)-L-s d) := mul_nonneg (Nat.cast_nonneg c) (sub_nonneg.mpr hsd) have hczweighted := mul_le_mul_of_nonneg_right hρk hcz have hraw : finiteCoprimeDensity N*Outer+(c : ℝ)*((R : ℝ)-L-s d)+ finiteCoprimeDensity N*(s d*R-(s d)^2/2) ≤ finiteCoprimeDensity N*Bound := by dsimp only [Outer,Bound] nlinarith only [hweighted,hczweighted] calc w d*Outer+f d = (finiteCoprimeDensity N*Outer+(c : ℝ)*((R : ℝ)-L-s d)+ finiteCoprimeDensity N*(s d*R-(s d)^2/2))/((d : ℝ)^2) := by dsimp only [w,f] ring _ ≤ (finiteCoprimeDensity N*Bound)/((d : ℝ)^2) := div_le_div_of_nonneg_right hraw (sq_nonneg _) _ = w d*Bound := by dsimp only [w]; ring have hsum := Finset.sum_le_sum hterms have hwSum : (∑ d ∈ Finset.Icc 1 N, w d) = 1 := finiteCoprimeDensity_weights_sum hN rw [Finset.sum_add_distrib,← Finset.sum_mul,← Finset.sum_mul,hwSum,one_mul,one_mul] at hsum exact hsum end /- OrderedOneSidedWitness -/ /- Ordered preferred witnesses and the linear cost of a witness on a division point. -/ section open Finset theorem ordered_one_sided_witness {S : Finset ℕ} {c L R : ℕ} (hLR : L ≤ R) (hreach : ∃ W, IsWitnessPair S c W ∧ (∃ x ∈ W, L ≤ x) ∧ ∃ y ∈ W, y ≤ R) (hnoL : ∀ W, IsWitnessPair S c W → L ∉ W) : ∃ x p : ℕ, IsWitnessPair S c {x,p} ∧ x < p ∧ x ≤ R ∧ L < p ∧ (c < x → x < L → R < p → S ∩ Finset.Icc x p = {x,p} ∨ IsCrooked (S ∩ Finset.Icc x p)) := by obtain ⟨x,p,hW,hLp,hcases⟩ := preferred_one_sided_witness hLR hreach have hxp : x ≠ p := by intro heq have hh := hW.1 simp only [heq,Finset.insert_eq_of_mem (Finset.mem_singleton_self p),Finset.card_singleton] at hh omega have hpL : L < p := by have hneq : p ≠ L := by intro heq; apply hnoL {x,p} hW; simp [heq] omega rcases hcases with hpR | ⟨hxL,hRp,hnoMiddle,hmin⟩ · by_cases hlt : x < p · exact ⟨x,p,hW,hlt,hlt.le.trans hpR,hpL,by intro _hcx _hxL hRp; omega⟩ · refine ⟨p,x,by simpa only [Finset.pair_comm] using hW,by omega,hpR,by omega,?_⟩ intro _hcp hpL' _hRx omega · exact ⟨x,p,hW,by omega,hxL.le.trans hLR,hpL, fun hcx _hxL _hRp => preferred_corner_crop_dichotomy hcx hxL hLR hRp hW hnoMiddle hmin⟩ theorem division_point_witness_family_card_le {N c L : ℕ} {F C : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hCF : C ⊆ F) (hc : ∀ S ∈ C, c ∈ S) (hL : ∀ S ∈ C, ∃ W, IsWitnessPair S c W ∧ L ∈ W) : C.card ≤ N := by classical let X := {S // S ∈ C} have hex : ∀ S : X, ∃ x : ℕ, IsWitnessPair S.val c {L,x} := by intro S obtain ⟨W,hW,hLW⟩ := hL S.val S.property obtain ⟨a,b,_hab,hrep⟩ := Finset.card_eq_two.mp hW.1 rw [hrep] at hLW simp only [Finset.mem_insert,Finset.mem_singleton] at hLW rcases hLW with hLa | hLb · exact ⟨b,by simpa only [hrep,← hLa] using hW⟩ · exact ⟨a,by simpa only [hrep,← hLb,Finset.pair_comm] using hW⟩ choose x hx using hex have hh := witness_row_card_le_interval hF hCF hc x hx (fun S => by have hxS : x S ∈ S.val := Finset.mem_of_mem_erase ((hx S).2.1 (by simp)) exact Finset.mem_powerset.mp (hF.1 (hCF S.property)) hxS) simpa only [Nat.card_Icc,Nat.add_sub_cancel] using hh end /- PrimitiveWitnessCoordinates -/ /- Reducing a rooted witness pair to coprime coordinates and its common step. -/ section theorem primitive_scale_of_pos {u v : ℕ} (hu : 0 < u) (hv : 0 < v) : ∃ d a b : ℕ, 0 < d ∧ d ≤ v ∧ 1 ≤ a ∧ 1 ≤ b ∧ a.Coprime b ∧ u = a*d ∧ v = b*d := by let d := u.gcd v have hd : 0 < d := Nat.gcd_pos_of_pos_left v hu have hdu : d ≤ u := Nat.gcd_le_left v hu have hdv : d ≤ v := Nat.gcd_le_right u hv exact ⟨d,u/d,v/d,hd,hdv,Nat.div_pos hdu hd,Nat.div_pos hdv hd, Nat.coprime_div_gcd_div_gcd hd, (Nat.div_mul_cancel (Nat.gcd_dvd_left u v)).symm, (Nat.div_mul_cancel (Nat.gcd_dvd_right u v)).symm⟩ theorem negative_middle_witness_coordinates {N c L R x p : ℕ} {S : Finset ℕ} (hcx : x < c) (hcL : c ≤ L) (hLp : L < p) (hpR : p ≤ R) (hRN : R ≤ N) (hW : IsWitnessPair S c {x,p}) : ∃ d a b : ℕ, 0 < d ∧ d ≤ N ∧ 1 ≤ a ∧ a ≤ c/d ∧ (L-c)/d < b ∧ b ≤ (R-c)/d ∧ a.Coprime b ∧ IsWitnessPair S c {c-a*d,c+b*d} := by have hcp : c < p := hcL.trans_lt hLp obtain ⟨d,a,b,hd,hdv,ha,hb,hcop,hua,hvb⟩ := primitive_scale_of_pos (by omega : 0 < c-x) (by omega : 0 < p-c) have hdN : d ≤ N := hdv.trans ((Nat.sub_le p c).trans (hpR.trans hRN)) have hadec : a*d ≤ c := by omega have hbdec : b*d ≤ R-c := by omega have hlb : (L-c)/d < b := (Nat.div_lt_iff_lt_mul hd).mpr (by omega) have hxeq : x = c-a*d := by omega have hpeq : p = c+b*d := by omega exact ⟨d,a,b,hd,hdN,ha,(Nat.le_div_iff_mul_le hd).mpr hadec,hlb, (Nat.le_div_iff_mul_le hd).mpr hbdec,hcop,by simpa only [← hxeq,← hpeq] using hW⟩ theorem positive_middle_witness_coordinates {N c L R x p : ℕ} {S : Finset ℕ} (hcx : c < x) (hxp : x < p) (hcL : c ≤ L) (hLp : L < p) (hpR : p ≤ R) (hRN : R ≤ N) (hW : IsWitnessPair S c {x,p}) : ∃ d a b : ℕ, 0 < d ∧ d ≤ N ∧ 1 ≤ a ∧ a < b ∧ (L-c)/d < b ∧ b ≤ (R-c)/d ∧ a.Coprime b ∧ IsWitnessPair S c {c+a*d,c+b*d} := by have hcp : c < p := hcx.trans hxp obtain ⟨d,a,b,hd,hdv,ha,_hb,hcop,hua,hvb⟩ := primitive_scale_of_pos (by omega : 0 < x-c) (by omega : 0 < p-c) have hdN : d ≤ N := hdv.trans ((Nat.sub_le p c).trans (hpR.trans hRN)) have hbdec : b*d ≤ R-c := by omega have hlb : (L-c)/d < b := (Nat.div_lt_iff_lt_mul hd).mpr (by omega) have hab : a < b := by by_contra hn have hmul := Nat.mul_le_mul_right d (show b ≤ a by omega) omega have hxeq : x = c+a*d := by omega have hpeq : p = c+b*d := by omega exact ⟨d,a,b,hd,hdN,ha,hab,hlb,(Nat.le_div_iff_mul_le hd).mpr hbdec,hcop, by simpa only [← hxeq,← hpeq] using hW⟩ end /- MiddleFamilySum -/ /- Summing the middle-region family estimates over their primitive steps. -/ section open Finset theorem middle_family_sum_bound {N c L R : ℕ} {F Cm Cp E : Finset (Finset ℕ)} (hN : 1 ≤ N) (hcL : c ≤ L) (hLR : L ≤ R) (hRN : R ≤ N) (hF : Erdos272.IsArithInterSet N F) (hMF : Cm ⊆ F) (hPF : Cp ⊆ F) (hEF : E ⊆ F) (hcM : ∀ S ∈ Cm, c ∈ S) (hcP : ∀ S ∈ Cp, c ∈ S) (hcrookedM : ∀ S ∈ Cm, IsCrooked S) (hcrookedP : ∀ S ∈ Cp, IsCrooked S) (dm dp de : Finset ℕ → ℕ) (m p : Finset ℕ → ℕ × ℕ) (model : Finset ℕ → ProgressionCell) (hm : ∀ S ∈ Cm, 0 < dm S ∧ dm S ≤ N ∧ 1 ≤ (m S).1 ∧ (m S).1 ≤ c/dm S ∧ (L-c)/dm S < (m S).2 ∧ (m S).2 ≤ (R-c)/dm S ∧ (m S).1.Coprime (m S).2 ∧ IsWitnessPair S c {c-(m S).1*dm S,c+(m S).2*dm S}) (hp : ∀ S ∈ Cp, 0 < dp S ∧ dp S ≤ N ∧ 1 ≤ (p S).1 ∧ (p S).1 < (p S).2 ∧ (L-c)/dp S < (p S).2 ∧ (p S).2 ≤ (R-c)/dp S ∧ (p S).1.Coprime (p S).2 ∧ IsWitnessPair S c {c+(p S).1*dp S,c+(p S).2*dp S}) (he : ∀ S ∈ E, 0 < de S ∧ de S ≤ N ∧ IsCenteredModel c (de S) (model S) S ∧ 1 ≤ (model S).val.1 ∧ (model S).val.1 ≤ c/de S ∧ (L-c)/de S < (model S).val.2 ∧ (model S).val.2 ≤ (R-c)/de S ∧ ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) : (5/3)*(L : ℝ)*(N-R)+((R : ℝ)-L)*(N-R)+(Cm.card : ℝ)+Cp.card+E.card ≤ (N : ℝ)^2/2-((L : ℝ)^2+((N : ℝ)-R)^2)/100+ (40*reciprocalSum N+2)*N*reciprocalSum N := by classical let I := Finset.Icc 1 N let CM (k : ℕ) := Cm.filter (fun S => dm S = k) let CP (k : ℕ) := Cp.filter (fun S => dp S = k) let EP (k : ℕ) := E.filter (fun S => de S = k) have hterms : ∀ k ∈ I, ∃ s : ℝ, 0 ≤ s ∧ s ≤ (R : ℝ)-L ∧ ((CM k).card : ℝ)+(CP k).card+(EP k).card ≤ ((c : ℝ)*((R : ℝ)-L-s)+finiteCoprimeDensity N*(s*R-s^2/2))/((k : ℝ)^2)+ (40*reciprocalSum N+2)*N/k := by intro k hk have hkpos : 0 < k := (Finset.mem_Icc.mp hk).1 have hcN : c ≤ N := hcL.trans (hLR.trans hRN) have hCN : c/k ≤ N := (Nat.div_le_self c k).trans hcN have hAM : (L-c)/k ≤ (R-c)/k := Nat.div_le_div_right (Nat.sub_le_sub_right hLR c) have hMN : (R-c)/k ≤ N := (Nat.div_le_self (R-c) k).trans ((Nat.sub_le R c).trans hRN) obtain ⟨e,hAe,heM,hbound⟩ := middle_step_coordinate_bound hN hCN hAM hMN hF ((Finset.filter_subset _ _).trans hMF) ((Finset.filter_subset _ _).trans hPF) ((Finset.filter_subset _ _).trans hEF) (fun S hS => hcM S (Finset.mem_filter.mp hS).1) (fun S hS => hcP S (Finset.mem_filter.mp hS).1) (fun S hS => hcrookedM S (Finset.mem_filter.mp hS).1) (fun S hS => hcrookedP S (Finset.mem_filter.mp hS).1) (fun S : {S // S ∈ CM k} => m S.val) (fun S : {S // S ∈ CP k} => p S.val) (fun S : {S // S ∈ EP k} => model S.val) (by intro S obtain ⟨hSC,hdk⟩ := Finset.mem_filter.mp S.property simpa only [hdk] using (hm S.val hSC).2.2) (by intro S obtain ⟨hSC,hdk⟩ := Finset.mem_filter.mp S.property simpa only [hdk] using (hp S.val hSC).2.2) (by intro S obtain ⟨hSC,hdk⟩ := Finset.mem_filter.mp S.property simpa only [hdk] using (he S.val hSC).2.2) exact middle_nat_grid_scale hN hcL hLR hRN hkpos hAe heM hbound have hchoices : ∀ k : ℕ, ∃ s : ℝ, k ∈ I → 0 ≤ s ∧ s ≤ (R : ℝ)-L ∧ ((CM k).card : ℝ)+(CP k).card+(EP k).card ≤ ((c : ℝ)*((R : ℝ)-L-s)+finiteCoprimeDensity N*(s*R-s^2/2))/((k : ℝ)^2)+ (40*reciprocalSum N+2)*N/k := by intro k by_cases hk : k ∈ I · obtain ⟨s,hs⟩ := hterms k hk exact ⟨s,fun _ => hs⟩ · exact ⟨0,fun hh => False.elim (hk hh)⟩ choose s hs using hchoices have hMpart : (Cm.card : ℝ) = ∑ k ∈ I, ((CM k).card : ℝ) := by exact_mod_cast Finset.card_eq_sum_card_fiberwise (show Set.MapsTo dm (Cm : Set (Finset ℕ)) (I : Set ℕ) from fun S hS => Finset.mem_Icc.mpr ⟨(hm S hS).1,(hm S hS).2.1⟩) have hPpart : (Cp.card : ℝ) = ∑ k ∈ I, ((CP k).card : ℝ) := by exact_mod_cast Finset.card_eq_sum_card_fiberwise (show Set.MapsTo dp (Cp : Set (Finset ℕ)) (I : Set ℕ) from fun S hS => Finset.mem_Icc.mpr ⟨(hp S hS).1,(hp S hS).2.1⟩) have hEpart : (E.card : ℝ) = ∑ k ∈ I, ((EP k).card : ℝ) := by exact_mod_cast Finset.card_eq_sum_card_fiberwise (show Set.MapsTo de (E : Set (Finset ℕ)) (I : Set ℕ) from fun S hS => Finset.mem_Icc.mpr ⟨(he S hS).1,(he S hS).2.1⟩) have hsum := Finset.sum_le_sum (fun k hk => (hs k hk).2.2) rw [Finset.sum_add_distrib,Finset.sum_add_distrib,Finset.sum_add_distrib, ← hMpart,← hPpart,← hEpart] at hsum have herr : (∑ k ∈ I, (40*reciprocalSum N+2)*N/(k : ℝ)) = (40*reciprocalSum N+2)*N*reciprocalSum N := by simp only [div_eq_mul_inv,← Finset.mul_sum,I,reciprocalSum] rw [herr] at hsum have hdef := weighted_middle_deficit hN hcL hLR hRN s (fun k hk => ⟨(hs k hk).1,(hs k hk).2.1⟩) linarith only [hsum,hdef] end /- MiddleProgressionModels -/ /- Centered models with a last endpoint in the middle region. -/ section open Finset theorem middle_progression_centered_model {N c L R a d : ℕ} {S : Finset ℕ} (hsub : S ⊆ Finset.Icc 1 N) (hd : 0 < d) (hcard : 4 ≤ S.card) (hrep : S = natAP a d S.card) (hcS : c ∈ S) (hac : a < c) (hcL : c ≤ L) (hLb : L < a+(S.card-1)*d) (hbR : a+(S.card-1)*d ≤ R) : ∃ p : ProgressionCell, IsCenteredModel c d p S ∧ 1 ≤ p.val.1 ∧ p.val.1 ≤ c/d ∧ (L-c)/d < p.val.2 ∧ p.val.2 ≤ (R-c)/d := by obtain ⟨i,hi,hci⟩ := mem_natAP.mp (hrep ▸ hcS) let p : ProgressionCell := ⟨(i,S.card-1-i),by omega⟩ have hp : IsCenteredModel c d p S := by change S.image (fun x : ℕ => (x : ℤ)) = _ have hcast := congrArg (fun T : Finset ℕ => T.image (fun x : ℕ => (x : ℤ))) hrep exact hcast.trans (by simpa only [hci] using natAP_cast_eq_affine_interval a d S.card i hi) have hi1 : 1 ≤ i := by nlinarith only [hci,hac] have hiC : i ≤ c/d := (Nat.le_div_iff_mul_le hd).mpr (by omega) have hlast : c+p.val.2*d = a+(S.card-1)*d := by have hsumi : i+(S.card-1-i) = S.card-1 := by omega dsimp only [p] nlinarith only [hci,hsumi] have hlow : (L-c)/d < p.val.2 := (Nat.div_lt_iff_lt_mul hd).mpr (by omega) have hupp : p.val.2 ≤ (R-c)/d := (Nat.le_div_iff_mul_le hd).mpr (by omega) exact ⟨p,hp,hi1,hiC,hlow,hupp⟩ end /- OneSidedOuterRectangles -/ /- The remaining two rectangle bounds for one-sided intrinsic witnesses. -/ section open Finset theorem crooked_witness_rectangle_card_le {N c : ℕ} {F C : Finset (Finset ℕ)} {A B : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hCF : C ⊆ F) (hc : ∀ S ∈ C, c ∈ S) (hcrooked : ∀ S ∈ C, IsCrooked S) (hW : ∀ S ∈ C, ∃ x ∈ A, ∃ p ∈ B, IsWitnessPair S c {x,p}) : C.card ≤ A.card*B.card := by have hh := private_pairs_and_intervals_card_le (E := ∅) (Pool := crossPairPool A B) hF hCF (Finset.empty_subset _) hc hcrooked (by intro S hS obtain ⟨x,hx,p,hp,hW⟩ := hW S hS exact ⟨{x,p},hW,Finset.mem_image.mpr ⟨(x,p),Finset.mem_product.mpr ⟨hx,hp⟩,rfl⟩⟩) (by intro S hS; simp only [Finset.notMem_empty] at hS) have hpool := crossPairPool_card_le A B simp only [Finset.card_empty,Nat.add_zero] at hh exact hh.trans hpool theorem middle_far_witnesses_card_le {N c L R : ℕ} {F C : Finset (Finset ℕ)} (hF : Erdos272.IsArithInterSet N F) (hCF : C ⊆ F) (hc : ∀ S ∈ C, c ∈ S) (hcrooked : ∀ S ∈ C, IsCrooked S) (x p : Finset ℕ → ℕ) (hW : ∀ S ∈ C, L < x S ∧ x S ≤ R ∧ R < p S ∧ IsWitnessPair S c {x S,p S}) : C.card ≤ (R-L)*(N-R) := by have hh := crooked_witness_rectangle_card_le (A := Finset.Ioc L R) (B := Finset.Ioc R N) hF hCF hc hcrooked (by intro S hS obtain ⟨hxL,hxR,hRp,hW⟩ := hW S hS have hpS : p S ∈ S := Finset.mem_of_mem_erase (hW.2.1 (by simp)) have hpN := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 (hCF hS)) hpS)).2 exact ⟨x S,Finset.mem_Ioc.mpr ⟨hxL,hxR⟩,p S,Finset.mem_Ioc.mpr ⟨hRp,hpN⟩,hW⟩) simpa only [Nat.card_Ioc] using hh theorem left_corner_and_intervals_card_le {N c R : ℕ} {F C E : Finset (Finset ℕ)} (hcR : c ≤ R) (hF : Erdos272.IsArithInterSet N F) (hCF : C ⊆ F) (hEF : E ⊆ F) (hc : ∀ S ∈ C, c ∈ S) (hcrooked : ∀ S ∈ C, IsCrooked S) (x p : Finset ℕ → ℕ) (hW : ∀ S ∈ C, x S < c ∧ R < p S ∧ IsWitnessPair S c {x S,p S}) (hE : ∀ S ∈ E, ∃ a b : ℕ, a < c ∧ R < b ∧ S = Finset.Icc a b) : C.card+E.card ≤ c*(N-R) := by let Pool := crossPairPool (Finset.Icc 1 c) (Finset.Ioc R N) have hh : C.card+E.card ≤ Pool.card := by apply private_pairs_and_intervals_card_le hF hCF hEF hc hcrooked · intro S hS obtain ⟨hxc,hRp,hW⟩ := hW S hS have hxS : x S ∈ S := Finset.mem_of_mem_erase (hW.2.1 (by simp)) have hpS : p S ∈ S := Finset.mem_of_mem_erase (hW.2.1 (by simp)) have hx1 := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 (hCF hS)) hxS)).1 have hpN := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 (hCF hS)) hpS)).2 exact ⟨{x S,p S},hW,Finset.mem_image.mpr ⟨(x S,p S),Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨hx1,hxc.le⟩,Finset.mem_Ioc.mpr ⟨hRp,hpN⟩⟩,rfl⟩⟩ · intro S hS obtain ⟨a,b,hac,hRb,hrep⟩ := hE S hS have hab : a ≤ b := hac.le.trans (hcR.trans hRb.le) have haS : a ∈ S := by rw [hrep]; exact Finset.mem_Icc.mpr ⟨le_rfl,hab⟩ have hbS : b ∈ S := by rw [hrep]; exact Finset.mem_Icc.mpr ⟨hab,le_rfl⟩ have ha1 := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 (hEF hS)) haS)).1 have hbN := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 (hEF hS)) hbS)).2 exact ⟨a,b,hac,hcR.trans_lt hRb,hrep,Finset.mem_image.mpr ⟨(a,b),Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨ha1,hac.le⟩,Finset.mem_Ioc.mpr ⟨hRb,hbN⟩⟩,rfl⟩⟩ have hpool : Pool.card ≤ c*(N-R) := by simpa only [Nat.card_Icc,Nat.add_sub_cancel,Nat.card_Ioc] using crossPairPool_card_le (Finset.Icc 1 c) (Finset.Ioc R N) exact hh.trans hpool end /- MiddlePreparedFamily -/ /- Applying the middle-region estimate directly to selected natural witness pairs. -/ section open Finset theorem middle_prepared_family_bound {N c L R : ℕ} {F C E : Finset (Finset ℕ)} (hN : 1 ≤ N) (hcL : c ≤ L) (hLR : L ≤ R) (hRN : R ≤ N) (hF : Erdos272.IsArithInterSet N F) (hCF : C ⊆ F) (hEF : E ⊆ F) (hcC : ∀ S ∈ C, c ∈ S) (hcrooked : ∀ S ∈ C, IsCrooked S) (x p a d : Finset ℕ → ℕ) (hW : ∀ S ∈ C, IsWitnessPair S c {x S,p S} ∧ x S < p S ∧ L < p S ∧ p S ≤ R) (hE : ∀ S ∈ E, 0 < d S ∧ d S ≤ N ∧ 4 ≤ S.card ∧ S = natAP (a S) (d S) S.card ∧ c ∈ S ∧ a S < c ∧ L < a S+(S.card-1)*d S ∧ a S+(S.card-1)*d S ≤ R) : (5/3)*(L : ℝ)*(N-R)+((R : ℝ)-L)*(N-R)+(C.card : ℝ)+E.card ≤ (N : ℝ)^2/2-((L : ℝ)^2+((N : ℝ)-R)^2)/100+ (40*reciprocalSum N+2)*N*reciprocalSum N := by classical let Cm := C.filter (fun S => x S < c) let Cp := C.filter (fun S => ¬x S < c) have hCm : Cm ⊆ C := Finset.filter_subset _ _ have hCp : Cp ⊆ C := Finset.filter_subset _ _ have hneg : ∀ S : Finset ℕ, ∃ dm am bm : ℕ, S ∈ Cm → 0 < dm ∧ dm ≤ N ∧ 1 ≤ am ∧ am ≤ c/dm ∧ (L-c)/dm < bm ∧ bm ≤ (R-c)/dm ∧ am.Coprime bm ∧ IsWitnessPair S c {c-am*dm,c+bm*dm} := by intro S by_cases hS : S ∈ Cm · have hw := hW S (hCm hS) obtain ⟨dm,am,bm,hh⟩ := negative_middle_witness_coordinates (Finset.mem_filter.mp hS).2 hcL hw.2.2.1 hw.2.2.2 hRN hw.1 exact ⟨dm,am,bm,fun _ => hh⟩ · exact ⟨1,1,1,fun hh => False.elim (hS hh)⟩ have hpos : ∀ S : Finset ℕ, ∃ dp ap bp : ℕ, S ∈ Cp → 0 < dp ∧ dp ≤ N ∧ 1 ≤ ap ∧ ap < bp ∧ (L-c)/dp < bp ∧ bp ≤ (R-c)/dp ∧ ap.Coprime bp ∧ IsWitnessPair S c {c+ap*dp,c+bp*dp} := by intro S by_cases hS : S ∈ Cp · have hw := hW S (hCp hS) have hxc : x S ≠ c := (Finset.mem_erase.mp (hw.1.2.1 (by simp))).1 have hcx : c < x S := by have hn := (Finset.mem_filter.mp hS).2; omega obtain ⟨dp,ap,bp,hh⟩ := positive_middle_witness_coordinates hcx hw.2.1 hcL hw.2.2.1 hw.2.2.2 hRN hw.1 exact ⟨dp,ap,bp,fun _ => hh⟩ · exact ⟨1,1,2,fun hh => False.elim (hS hh)⟩ have hemodel : ∀ S : Finset ℕ, ∃ model : ProgressionCell, S ∈ E → IsCenteredModel c (d S) model S ∧ 1 ≤ model.val.1 ∧ model.val.1 ≤ c/d S ∧ (L-c)/d S < model.val.2 ∧ model.val.2 ≤ (R-c)/d S := by intro S by_cases hS : S ∈ E · obtain ⟨hd,_hdN,hcard,hrep,hc,hac,hLb,hbR⟩ := hE S hS obtain ⟨model,hh⟩ := middle_progression_centered_model (Finset.mem_powerset.mp (hF.1 (hEF hS))) hd hcard hrep hc hac hcL hLb hbR exact ⟨model,fun _ => hh⟩ · exact ⟨⟨(0,3),by decide⟩,fun hh => False.elim (hS hh)⟩ choose dm am bm hm using hneg choose dp ap bp hp using hpos choose model hmodel using hemodel have hh := middle_family_sum_bound hN hcL hLR hRN hF (hCm.trans hCF) (hCp.trans hCF) hEF (fun S hS => hcC S (hCm hS)) (fun S hS => hcC S (hCp hS)) (fun S hS => hcrooked S (hCm hS)) (fun S hS => hcrooked S (hCp hS)) dm dp d (fun S => (am S,bm S)) (fun S => (ap S,bp S)) model hm hp (by intro S hS have heS := hE S hS have hmS := hmodel S hS refine ⟨heS.1,heS.2.1,hmS.1,hmS.2.1,hmS.2.2.1,hmS.2.2.2.1,hmS.2.2.2.2,?_⟩ rw [heS.2.2.2.1] exact ⟨(S.card : ℕ∞),natAP_isAP heS.1⟩) have hpart : (Cm.card : ℝ)+Cp.card = C.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := C) (fun S => x S < c) linarith only [hh,hpart] end /- PreparedPartitionLemmas -/ /- Elementary interval and finite-partition identities used in the one-sided assembly. -/ section open Finset theorem natAP_one_eq_Icc {a k : ℕ} (hk : 0 < k) : natAP a 1 k = Finset.Icc a (a+(k-1)) := by ext x constructor · intro hx have hh := natAP_bounds_of_mem hx exact Finset.mem_Icc.mpr (by simpa only [Nat.mul_one] using hh) · intro hx obtain ⟨hax,hxend⟩ := Finset.mem_Icc.mp hx exact mem_natAP.mpr ⟨x-a,by omega,by omega⟩ theorem card_le_four_of_cover {α : Type*} [DecidableEq α] {S A B C D : Finset α} (hcover : S ⊆ A ∪ B ∪ C ∪ D) : S.card ≤ A.card+B.card+C.card+D.card := by have hh := Finset.card_le_card hcover have h₁ := Finset.card_union_le A B have h₂ := Finset.card_union_le (A ∪ B) C have h₃ := Finset.card_union_le (A ∪ B ∪ C) D omega theorem card_le_five_of_cover {α : Type*} [DecidableEq α] {S A B C D E : Finset α} (hcover : S ⊆ A ∪ B ∪ C ∪ D ∪ E) : S.card ≤ A.card+B.card+C.card+D.card+E.card := by have hh := Finset.card_le_card hcover have h₁ := card_le_four_of_cover (Finset.Subset.refl (A ∪ B ∪ C ∪ D)) have h₂ := Finset.card_union_le (A ∪ B ∪ C ∪ D) E omega end /- OneSidedPreparedBound -/ /- Assembly of the prepared one-sided family estimate, with a retained endpoint deficit. -/ section open Finset theorem one_sided_prepared_card_le {N c L R : ℕ} {F C E : Finset (Finset ℕ)} (hN : 1 ≤ N) (hcL : c ≤ L) (hLR : L ≤ R) (hRN : R ≤ N) (hF : Erdos272.IsArithInterSet N F) (hCF : C ⊆ F) (hEF : E ⊆ F) (hcC : ∀ S ∈ C, c ∈ S) (hcrooked : ∀ S ∈ C, IsCrooked S) (x p a d : Finset ℕ → ℕ) (hW : ∀ S ∈ C, IsWitnessPair S c {x S,p S} ∧ x S < p S ∧ x S ≤ R ∧ L < p S ∧ x S ≠ L ∧ (c < x S → x S < L → R < p S → S ∩ Finset.Icc (x S) (p S) = {x S,p S} ∨ IsCrooked (S ∩ Finset.Icc (x S) (p S)))) (hE : ∀ S ∈ E, 0 < d S ∧ d S ≤ N ∧ 4 ≤ S.card ∧ S = natAP (a S) (d S) S.card ∧ (c ∈ S → a S < c ∧ L < a S+(S.card-1)*d S) ∧ (c ∉ S → a S ≤ L ∧ R ≤ a S+(S.card-1)*d S)) : (C.card : ℝ)+E.card ≤ (N : ℝ)^2/2-((L : ℝ)^2+((N : ℝ)-R)^2)/100+ (40*reciprocalSum N+4)*N*reciprocalSum N+4*N := by classical let b (S : Finset ℕ) := a S+(S.card-1)*d S let CM := C.filter (fun S => p S ≤ R) let CL := C.filter (fun S => R < p S ∧ x S < c) let CQ := C.filter (fun S => R < p S ∧ c < x S ∧ x S < L) let CX := C.filter (fun S => R < p S ∧ L < x S) let EM := E.filter (fun S => c ∈ S ∧ b S ≤ R) let EX := E.filter (fun S => 2 ≤ d S ∧ R ≤ b S) let EI := E.filter (fun S => c ∈ S ∧ d S = 1 ∧ R < b S) let EP := E.filter (fun S => c ∉ S ∧ d S = 1 ∧ R < b S) let EB := E.filter (fun S => c ∉ S ∧ d S = 1 ∧ b S = R) have hCMM : CM ⊆ C := Finset.filter_subset _ _ have hCLM : CL ⊆ C := Finset.filter_subset _ _ have hCQM : CQ ⊆ C := Finset.filter_subset _ _ have hCXM : CX ⊆ C := Finset.filter_subset _ _ have hEME : EM ⊆ E := Finset.filter_subset _ _ have hEXE : EX ⊆ E := Finset.filter_subset _ _ have hEIE : EI ⊆ E := Finset.filter_subset _ _ have hEPE : EP ⊆ E := Finset.filter_subset _ _ have hEBE : EB ⊆ E := Finset.filter_subset _ _ have hCcover : C ⊆ CM ∪ CL ∪ CQ ∪ CX := by intro S hS have hw := hW S hS have hxc : x S ≠ c := (Finset.mem_erase.mp (hw.1.2.1 (by simp))).1 have hxL := hw.2.2.2.2.1 simp only [CM,CL,CQ,CX,Finset.mem_union,Finset.mem_filter,hS,true_and] omega have hEcover : E ⊆ EM ∪ EX ∪ EI ∪ EP ∪ EB := by intro S hS have heS := hE S hS have hdpos := heS.1 by_cases hcS : c ∈ S · have hh := heS.2.2.2.2.1 hcS simp only [EM,EX,EI,EP,EB,Finset.mem_union,Finset.mem_filter,hS,true_and,hcS, not_true_eq_false,false_and,or_false] omega · have hh := heS.2.2.2.2.2 hcS change a S ≤ L ∧ R ≤ b S at hh simp only [EM,EX,EI,EP,EB,Finset.mem_union,Finset.mem_filter,hS,true_and,hcS, not_false_eq_true,false_and,false_or] omega have hCcount : (C.card : ℝ) ≤ CM.card+CL.card+CQ.card+CX.card := by exact_mod_cast card_le_four_of_cover hCcover have hEcount : (E.card : ℝ) ≤ EM.card+EX.card+EI.card+EP.card+EB.card := by exact_mod_cast card_le_five_of_cover hEcover have hinterval : ∀ S ∈ E, d S = 1 → S = Finset.Icc (a S) (b S) := by intro S hS hd1 have heS := hE S hS calc S = natAP (a S) (d S) S.card := heS.2.2.2.1 _ = Finset.Icc (a S) (b S) := by rw [hd1,natAP_one_eq_Icc (by omega : 0 < S.card)] simp only [b,hd1,Nat.mul_one] have hbN : ∀ S ∈ E, b S ≤ N := by intro S hS have heS := hE S hS have hbS : b S ∈ S := by have hh : b S ∈ natAP (a S) (d S) S.card := mem_natAP.mpr ⟨S.card-1,by have hh := heS.2.2.1; omega,rfl⟩ simpa only [← heS.2.2.2.1] using hh exact (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 (hEF hS)) hbS)).2 have hmiddle := middle_prepared_family_bound hN hcL hLR hRN hF (hCMM.trans hCF) (hEME.trans hEF) (fun S hS => hcC S (hCMM hS)) (fun S hS => hcrooked S (hCMM hS)) x p a d (by intro S hS have hw := hW S (hCMM hS) exact ⟨hw.1,hw.2.1,hw.2.2.2.1,(Finset.mem_filter.mp hS).2⟩) (by intro S hS obtain ⟨hSE,hcS,hbR⟩ := Finset.mem_filter.mp hS have heS := hE S hSE obtain ⟨hac,hLb⟩ := heS.2.2.2.2.1 hcS exact ⟨heS.1,heS.2.1,heS.2.2.1,heS.2.2.2.1,hcS,hac,hLb,hbR⟩) have hleftNat := left_corner_and_intervals_card_le (hcL.trans hLR) hF (hCLM.trans hCF) (hEIE.trans hEF) (fun S hS => hcC S (hCLM hS)) (fun S hS => hcrooked S (hCLM hS)) x p (by intro S hS obtain ⟨hSC,hRp,hxc⟩ := Finset.mem_filter.mp hS exact ⟨hxc,hRp,(hW S hSC).1⟩) (by intro S hS obtain ⟨hSE,hcS,hd1,hRb⟩ := Finset.mem_filter.mp hS exact ⟨a S,b S,((hE S hSE).2.2.2.2.1 hcS).1,hRb,hinterval S hSE hd1⟩) have hleft : (CL.card : ℝ)+EI.card ≤ (c : ℝ)*((N : ℝ)-R) := by exact_mod_cast hleftNat have hrightNat := corner_witnesses_and_intervals_card_le hLR hRN hF (hCQM.trans hCF) (hEPE.trans hEF) (fun S hS => hcC S (hCQM hS)) x p a b (by intro S hS obtain ⟨hSC,hRp,hcx,hxL⟩ := Finset.mem_filter.mp hS have hw := hW S hSC have hpS : p S ∈ S := Finset.mem_of_mem_erase (hw.1.2.1 (by simp)) have hpN := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 (hCF hSC)) hpS)).2 exact ⟨hcx,hxL,hRp,hpN,hw.1,hw.2.2.2.2.2 hcx hxL hRp⟩) (by intro S hS obtain ⟨hSE,hcS,hd1,hRb⟩ := Finset.mem_filter.mp hS have heS := hE S hSE have hrep := hinterval S hSE hd1 have hca : c < a S := by by_contra hn apply hcS rw [hrep] exact Finset.mem_Icc.mpr ⟨by omega,by omega⟩ exact ⟨hca,(heS.2.2.2.2.2 hcS).1,hRb,hbN S hSE,hrep⟩) have hright : (CQ.card : ℝ)+EP.card ≤ ((L : ℝ)-c)*((N : ℝ)-R)+2*N := by exact_mod_cast hrightNat have hfarNat := middle_far_witnesses_card_le hF (hCXM.trans hCF) (fun S hS => hcC S (hCXM hS)) (fun S hS => hcrooked S (hCXM hS)) x p (by intro S hS obtain ⟨hSC,hRp,hLx⟩ := Finset.mem_filter.mp hS have hw := hW S hSC exact ⟨hLx,hw.2.2.1,hRp,hw.1⟩) have hfar : (CX.card : ℝ) ≤ ((R : ℝ)-L)*((N : ℝ)-R) := by exact_mod_cast hfarNat have hlarge := large_step_endpoint_rectangle_card_le (hLR.trans hRN) hRN (admissible_subfamily hF (hEXE.trans hEF)) (fun S hS => by have hh := (hE S (hEXE hS)).2.2.1; omega) (by intro S hS obtain ⟨hSE,hd2,hRb⟩ := Finset.mem_filter.mp hS have heS := hE S hSE have haL : a S ≤ L := by by_cases hcS : c ∈ S · exact ((heS.2.2.2.2.1 hcS).1.le).trans hcL · exact (heS.2.2.2.2.2 hcS).1 exact ⟨a S,d S,hd2,heS.2.1,heS.2.2.2.1,haL,hRb⟩) have hboundaryNat : EB.card ≤ N := by have hcover : EB ⊆ (Finset.Icc 1 N).image (fun a => Finset.Icc a R) := by intro S hS obtain ⟨hSE,_hcS,hd1,hbR⟩ := Finset.mem_filter.mp hS have hrep := hinterval S hSE hd1 have haS : a S ∈ S := by have hh : a S ∈ natAP (a S) (d S) S.card := mem_natAP.mpr ⟨0,by have hh := (hE S hSE).2.2.1; omega,by simp⟩ simpa only [← (hE S hSE).2.2.2.1] using hh exact Finset.mem_image.mpr ⟨a S,Finset.mem_powerset.mp (hF.1 (hEF hSE)) haS, by simpa only [hbR] using hrep.symm⟩ have hh := (Finset.card_le_card hcover).trans (Finset.card_image_le) simpa only [Nat.card_Icc,Nat.add_sub_cancel] using hh have hboundary : (EB.card : ℝ) ≤ N := by exact_mod_cast hboundaryNat nlinarith only [hCcount,hEcount,hmiddle,hleft,hright,hfar,hlarge,hboundary] end /- ProgressionBoundaryCount -/ /- Linear-harmonic bounds for progressions with a prescribed endpoint. -/ section open Finset theorem same_step_fixed_endpoint_card_le {N d q : ℕ} {F : Finset (Finset ℕ)} (first : Bool) (hd : 0 < d) (hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N) (hcard : ∀ S ∈ F, 0 < S.card) (hparam : ∀ S ∈ F, ∃ a : ℕ, S = natAP a d S.card ∧ (if first then a else a+(S.card-1)*d) = q) : F.card ≤ N/d+1 := by classical let X := {S // S ∈ F} have hp : ∀ S : X, ∃ a : ℕ, S.val = natAP a d S.val.card ∧ (if first then a else a+(S.val.card-1)*d) = q := fun S => hparam S.val S.property choose a hrep hend using hp let f (S : X) := S.val.card-1 have hlen : ∀ S : X, f S ≤ N/d := by intro S have hbS : a S+(S.val.card-1)*d ∈ S.val := by have hh : a S+(S.val.card-1)*d ∈ natAP (a S) d S.val.card := mem_natAP.mpr ⟨S.val.card-1,by have hh := hcard S.val S.property; omega,rfl⟩ simpa only [← hrep S] using hh have hbN := (Finset.mem_Icc.mp (hsub S.val S.property hbS)).2 exact (Nat.le_div_iff_mul_le hd).mpr (by dsimp only [f]; omega) have hinj : Function.Injective f := by intro S T heq have hSC := hcard S.val S.property have hTC := hcard T.val T.property have hcards : S.val.card = T.val.card := by dsimp only [f] at heq; omega have haeq : a S = a T := by have hSe := hend S have hTe := hend T cases first <;> simp only [Bool.false_eq_true,↓reduceIte] at hSe hTe · rw [hcards] at hSe omega · omega apply Subtype.ext rw [hrep S,hrep T,hcards,haeq] have hmaps : Set.MapsTo f ((Finset.univ : Finset X) : Set X) (Finset.range (N/d+1) : Set ℕ) := by intro S _hS exact Finset.mem_range.mpr (by have hh := hlen S; omega) simpa only [Finset.card_univ,Finset.card_range,X,Fintype.card_coe] using Finset.card_le_card_of_injOn f hmaps hinj.injOn theorem progression_fixed_endpoint_card_le {N q : ℕ} {F : Finset (Finset ℕ)} (first : Bool) (hsub : ∀ S ∈ F, S ⊆ Finset.Icc 1 N) (hcard : ∀ S ∈ F, 0 < S.card) (hparam : ∀ S ∈ F, ∃ a d : ℕ, 0 < d ∧ d ≤ N ∧ S = natAP a d S.card ∧ (if first then a else a+(S.card-1)*d) = q) : (F.card : ℝ) ≤ (N : ℝ)*reciprocalSum N+N := by classical have hp : ∀ S : Finset ℕ, ∃ a d : ℕ, S ∈ F → 0 < d ∧ d ≤ N ∧ S = natAP a d S.card ∧ (if first then a else a+(S.card-1)*d) = q := by intro S by_cases hS : S ∈ F · obtain ⟨a,d,hh⟩ := hparam S hS exact ⟨a,d,fun _ => hh⟩ · exact ⟨0,1,fun hh => False.elim (hS hh)⟩ choose a d hspec using hp have hpart : (F.card : ℝ) = ∑ k ∈ Finset.Icc 1 N, ((F.filter (fun S => d S = k)).card : ℝ) := by exact_mod_cast Finset.card_eq_sum_card_fiberwise (show Set.MapsTo d (F : Set (Finset ℕ)) (Finset.Icc 1 N : Set ℕ) from fun S hS => Finset.mem_Icc.mpr ⟨(hspec S hS).1,(hspec S hS).2.1⟩) have hbound : ∀ k ∈ Finset.Icc 1 N, ((F.filter (fun S => d S = k)).card : ℝ) ≤ (N : ℝ)/k+1 := by intro k hk have hh := same_step_fixed_endpoint_card_le (F := F.filter (fun S => d S = k)) first (Finset.mem_Icc.mp hk).1 (fun S hS => hsub S (Finset.mem_filter.mp hS).1) (fun S hS => hcard S (Finset.mem_filter.mp hS).1) (by intro S hS obtain ⟨hSF,hdk⟩ := Finset.mem_filter.mp hS exact ⟨a S,by simpa only [hdk] using (hspec S hSF).2.2⟩) have hhR : ((F.filter (fun S => d S = k)).card : ℝ) ≤ ((N/k : ℕ)+1 : ℝ) := by exact_mod_cast hh have hdiv := Nat.cast_div_le (α := ℝ) (m := N) (n := k) linarith only [hhR,hdiv] rw [hpart] calc _ ≤ ∑ k ∈ Finset.Icc 1 N, ((N : ℝ)/k+1) := Finset.sum_le_sum hbound _ = _ := by simp [div_eq_mul_inv,Finset.sum_add_distrib,← Finset.mul_sum,reciprocalSum] end /- CrookedOneSidedPreparation -/ /- Preparing all but a controlled number of crooked members for the one-sided count. -/ section open Finset theorem prepare_one_sided_crooked {N c L R : ℕ} {F C : Finset (Finset ℕ)} {P T : Finset ℕ} (hcL : c ≤ L) (hLR : L ≤ R) (hF : Erdos272.IsArithInterSet N F) (hCF : C ⊆ F) (hcC : ∀ S ∈ C, c ∈ S) (hcrooked : ∀ S ∈ C, IsCrooked S) (hP : P ∈ F) (hcP : c ∉ P) (hLP : ∀ x ∈ P, L ≤ x) (hT : T ∈ F) (hcT : c ∉ T) (hTR : ∀ x ∈ T, x ≤ R) : ∃ G : Finset (Finset ℕ), G ⊆ C ∧ C.card ≤ G.card+N+witnessExceptionBound N c ∧ ∃ x p : Finset ℕ → ℕ, ∀ S ∈ G, IsWitnessPair S c {x S,p S} ∧ x S < p S ∧ x S ≤ R ∧ L < p S ∧ x S ≠ L ∧ (c < x S → x S < L → R < p S → S ∩ Finset.Icc (x S) (p S) = {x S,p S} ∨ IsCrooked (S ∩ Finset.Icc (x S) (p S))) := by classical let High (S : Finset ℕ) := ∃ W, IsWitnessPair S c W ∧ ∃ x ∈ W, L ≤ x let Boundary (S : Finset ℕ) := ∃ W, IsWitnessPair S c W ∧ L ∈ W let A := C.filter High let B := C.filter (fun S => ¬High S) let G := A.filter (fun S => ¬Boundary S) let D := A.filter Boundary have hAC : A ⊆ C := Finset.filter_subset _ _ have hBC : B ⊆ C := Finset.filter_subset _ _ have hGA : G ⊆ A := Finset.filter_subset _ _ have hDA : D ⊆ A := Finset.filter_subset _ _ have hGC : G ⊆ C := hGA.trans hAC have hB : B.card ≤ witnessExceptionBound N c := by apply restricted_witness_bad_family_card_le (admissible_subfamily hF (hBC.trans hCF)) (fun S hS => hcC S (hBC hS)) (fun S hS => hcrooked S (hBC hS)) · intro S hS obtain ⟨z,hz⟩ := arithInter_inter_nonempty hF (hCF (hBC hS)) hP ⟨c,hcC S (hBC hS)⟩ obtain ⟨hzS,hzP⟩ := Finset.mem_inter.mp hz exact ⟨z,Finset.mem_inter.mpr ⟨Finset.mem_erase.mpr ⟨fun heq => hcP (heq ▸ hzP),hzS⟩,hzP⟩⟩ · intro S hS W hW apply Finset.disjoint_left.mpr intro z hzW hzP exact (Finset.mem_filter.mp hS).2 ⟨W,hW,z,hzW,hLP z hzP⟩ have hD : D.card ≤ N := division_point_witness_family_card_le hF ((hDA.trans hAC).trans hCF) (fun S hS => hcC S (hAC (hDA hS))) (fun S hS => (Finset.mem_filter.mp hS).2) have hpart : A.card+B.card = C.card := Finset.card_filter_add_card_filter_not (s := C) High have hpartA : D.card+G.card = A.card := Finset.card_filter_add_card_filter_not (s := A) Boundary refine ⟨G,hGC,by omega,?_⟩ have hchoice : ∀ S : Finset ℕ, ∃ x p : ℕ, S ∈ G → IsWitnessPair S c {x,p} ∧ x < p ∧ x ≤ R ∧ L < p ∧ x ≠ L ∧ (c < x → x < L → R < p → S ∩ Finset.Icc x p = {x,p} ∨ IsCrooked (S ∩ Finset.Icc x p)) := by intro S by_cases hS : S ∈ G · have hAS := hGA hS obtain ⟨W,hW,hhigh⟩ := (Finset.mem_filter.mp hAS).2 have hnoL : ∀ W, IsWitnessPair S c W → L ∉ W := by intro W hW hLW exact (Finset.mem_filter.mp hS).2 ⟨W,hW,hLW⟩ obtain ⟨x,p,hxp,hlt,hxR,hLp,hcrop⟩ := ordered_one_sided_witness hLR (witness_reaches_avoider_endpoint hF (hCF (hGC hS)) hT (hcC S (hGC hS)) hcT hTR (hcL.trans hLR) hLR hW hhigh) hnoL have hxL : x ≠ L := by intro heq; exact hnoL {x,p} hxp (by simp [heq]) exact ⟨x,p,fun _ => ⟨hxp,hlt,hxR,hLp,hxL,hcrop⟩⟩ · exact ⟨0,0,fun hh => False.elim (hS hh)⟩ choose x p hspec using hchoice exact ⟨x,p,hspec⟩ end /- ProgressionOneSidedPreparation -/ /- Preparing progression endpoints for the one-sided estimate. -/ section open Finset theorem prepare_one_sided_progressions {N c L R : ℕ} {F A : Finset (Finset ℕ)} {P : Finset ℕ} (hF : Erdos272.IsArithInterSet N F) (hAF : A ⊆ F) (hAP : ∀ S ∈ A, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hP : P ∈ F) (hLP : ∀ x ∈ P, L ≤ x) (houtside : ∀ S ∈ A, c ∉ S → (∃ u ∈ S, u ≤ L) ∧ ∃ v ∈ S, R ≤ v) : ∃ E : Finset (Finset ℕ), E ⊆ A ∧ (A.card : ℝ) ≤ E.card+2*N*reciprocalSum N+20*N+3 ∧ ∃ a d : Finset ℕ → ℕ, ∀ S ∈ E, 0 < d S ∧ d S ≤ N ∧ 4 ≤ S.card ∧ S = natAP (a S) (d S) S.card ∧ (c ∈ S → a S < c ∧ L < a S+(S.card-1)*d S) ∧ (c ∉ S → a S ≤ L ∧ R ≤ a S+(S.card-1)*d S) := by classical let B := A.filter (fun S => 4 ≤ S.card) let Small := A.filter (fun S => ¬4 ≤ S.card) have hBA : B ⊆ A := Finset.filter_subset _ _ have hSA : Small ⊆ A := Finset.filter_subset _ _ have hsmall : Small.card ≤ 18*N+3 := progression_family_small_card_le (admissible_subfamily hF (hSA.trans hAF)) (fun S hS => hAP S (hSA hS)) (fun S hS => by have hh := (Finset.mem_filter.mp hS).2; omega) have hparam : ∀ S : Finset ℕ, ∃ a d : ℕ, S ∈ B → 0 < d ∧ d ≤ N ∧ S = natAP a d S.card := by intro S by_cases hS : S ∈ B · have hsize := (Finset.mem_filter.mp hS).2 obtain ⟨l,hl⟩ := hAP S (hBA hS) obtain ⟨a,d,hd,hrep⟩ := nat_ap_eq_natAP hl (by omega : 2 ≤ S.card) have hstep : a+d ∈ S := by have hh : a+d ∈ natAP a d S.card := mem_natAP.mpr ⟨1,by omega,by simp⟩ simpa only [← hrep] using hh have hdN : d ≤ N := by have hh := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 (hAF (hBA hS))) hstep)).2 omega exact ⟨a,d,fun _ => ⟨hd,hdN,hrep⟩⟩ · exact ⟨0,1,fun hh => False.elim (hS hh)⟩ choose a d hspec using hparam let b (S : Finset ℕ) := a S+(S.card-1)*d S let D := B.filter (fun S => a S = c) let Q := B.filter (fun S => ¬a S = c) let J := Q.filter (fun S => b S = L) let E := Q.filter (fun S => ¬b S = L) have hDB : D ⊆ B := Finset.filter_subset _ _ have hQB : Q ⊆ B := Finset.filter_subset _ _ have hJQ : J ⊆ Q := Finset.filter_subset _ _ have hEQ : E ⊆ Q := Finset.filter_subset _ _ have hJB : J ⊆ B := hJQ.trans hQB have hEB : E ⊆ B := hEQ.trans hQB have hD : (D.card : ℝ) ≤ (N : ℝ)*reciprocalSum N+N := by apply progression_fixed_endpoint_card_le true (fun S hS => Finset.mem_powerset.mp (hF.1 (hAF (hBA (hDB hS))))) (fun S hS => by have hh := (Finset.mem_filter.mp (hDB hS)).2; omega) intro S hS have hh := hspec S (hDB hS) exact ⟨a S,d S,hh.1,hh.2.1,hh.2.2,by simpa using (Finset.mem_filter.mp hS).2⟩ have hJ : (J.card : ℝ) ≤ (N : ℝ)*reciprocalSum N+N := by apply progression_fixed_endpoint_card_le false (fun S hS => Finset.mem_powerset.mp (hF.1 (hAF (hBA (hJB hS))))) (fun S hS => by have hh := (Finset.mem_filter.mp (hJB hS)).2; omega) intro S hS have hh := hspec S (hJB hS) exact ⟨a S,d S,hh.1,hh.2.1,hh.2.2,by simpa only [Bool.false_eq_true,↓reduceIte] using (Finset.mem_filter.mp hS).2⟩ have hpartA : (B.card : ℝ)+Small.card = A.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := A) (fun S => 4 ≤ S.card) have hpartB : (D.card : ℝ)+Q.card = B.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := B) (fun S => a S = c) have hpartQ : (J.card : ℝ)+E.card = Q.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := Q) (fun S => b S = L) have hsmallR : (Small.card : ℝ) ≤ 18*(N : ℝ)+3 := by exact_mod_cast hsmall refine ⟨E,hEB.trans hBA,by linarith only [hD,hJ,hpartA,hpartB,hpartQ,hsmallR],a,d,?_⟩ intro S hS have hSB := hEB hS have hsize := (Finset.mem_filter.mp hSB).2 have hSp := hspec S hSB refine ⟨hSp.1,hSp.2.1,hsize,hSp.2.2,?_,?_⟩ · intro hcS have hac := (natAP_bounds_of_mem (hSp.2.2 ▸ hcS)).1 have haNe := (Finset.mem_filter.mp (hEQ hS)).2 obtain ⟨z,hz⟩ := arithInter_inter_nonempty hF (hAF (hBA hSB)) hP ⟨c,hcS⟩ obtain ⟨hzS,hzP⟩ := Finset.mem_inter.mp hz have hzb := (natAP_bounds_of_mem (hSp.2.2 ▸ hzS)).2 have hLz := hLP z hzP have hbNe := (Finset.mem_filter.mp hS).2 dsimp only [b] at hbNe exact ⟨by omega,by omega⟩ · intro hcS obtain ⟨⟨u,hu,huL⟩,v,hv,hRv⟩ := houtside S (hBA hSB) hcS have hau := (natAP_bounds_of_mem (hSp.2.2 ▸ hu)).1 have hvb := (natAP_bounds_of_mem (hSp.2.2 ▸ hv)).2 exact ⟨hau.trans huL,hRv.trans hvb⟩ end /- OneSidedFiniteBound -/ /- The full finite one-sided estimate, including witness and endpoint preparation costs. -/ section open Finset theorem one_sided_family_finite_bound {N c L R : ℕ} {F : Finset (Finset ℕ)} {P T : Finset ℕ} (hN : 1 ≤ N) (hcL : c ≤ L) (hLR : L ≤ R) (hRN : R ≤ N) (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, IsCrooked S → c ∈ S) (hP : P ∈ F) (hcP : c ∉ P) (hLP : ∀ x ∈ P, L ≤ x) (hT : T ∈ F) (hcT : c ∉ T) (hTR : ∀ x ∈ T, x ≤ R) (houtside : ∀ S ∈ F, c ∉ S → (∃ u ∈ S, u ≤ L) ∧ ∃ v ∈ S, R ≤ v) : (F.card : ℝ) ≤ (N : ℝ)^2/2-((L : ℝ)^2+((N : ℝ)-R)^2)/100+ (40*reciprocalSum N+6)*N*reciprocalSum N+25*N+3+witnessExceptionBound N c := by classical let C := F.filter IsCrooked let A := F.filter (fun S => ¬IsCrooked S) have hCF : C ⊆ F := Finset.filter_subset _ _ have hAF : A ⊆ F := Finset.filter_subset _ _ have hcC : ∀ S ∈ C, c ∈ S := fun S hS => hc S (hCF hS) (Finset.mem_filter.mp hS).2 have hC : ∀ S ∈ C, IsCrooked S := fun S hS => (Finset.mem_filter.mp hS).2 have hA : ∀ S ∈ A, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l := by intro S hS exact of_not_not (Finset.mem_filter.mp hS).2 obtain ⟨G,hGC,hCG,x,p,hW⟩ := prepare_one_sided_crooked hcL hLR hF hCF hcC hC hP hcP hLP hT hcT hTR obtain ⟨E,hEA,hAE,a,d,hE⟩ := prepare_one_sided_progressions hF hAF hA hP hLP (fun S hS hcS => houtside S (hAF hS) hcS) have hprepared := one_sided_prepared_card_le hN hcL hLR hRN hF (hGC.trans hCF) (hEA.trans hAF) (fun S hS => hcC S (hGC hS)) (fun S hS => hC S (hGC hS)) x p a d hW hE have hCGR : (C.card : ℝ) ≤ G.card+N+witnessExceptionBound N c := by exact_mod_cast hCG have hpart : (C.card : ℝ)+A.card = F.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := F) IsCrooked nlinarith only [hprepared,hCGR,hAE,hpart] theorem one_sided_error_le_natLog {N c : ℕ} (hcI : c ∈ Finset.Icc 1 N) : (40*reciprocalSum N+6)*N*reciprocalSum N+25*N+3+witnessExceptionBound N c ≤ 512*(N : ℝ)*((Nat.log 2 N : ℝ)+1)^3 := by let J : ℝ := (Nat.log 2 N : ℝ)+1 have hJ : 1 ≤ J := by dsimp only [J] have hh := Nat.cast_nonneg (α := ℝ) (Nat.log 2 N) linarith only [hh] have hJ0 : 0 ≤ J := by linarith only [hJ] have hH0 := reciprocalSum_nonneg N have hH : reciprocalSum N ≤ 2*J := reciprocalSum_le_natLog N have hNs : 1 ≤ N := (Finset.mem_Icc.mp hcI).1.trans (Finset.mem_Icc.mp hcI).2 have hN : (1 : ℝ) ≤ N := by exact_mod_cast hNs have hN0 : (0 : ℝ) ≤ N := Nat.cast_nonneg N have hJ2 : J ≤ J^2 := by nlinarith only [mul_nonneg hJ0 (sub_nonneg.mpr hJ)] have hJ3 : J^2 ≤ J^3 := by nlinarith only [mul_nonneg (sq_nonneg J) (sub_nonneg.mpr hJ)] have hJ13 : 1 ≤ J^3 := hJ.trans (hJ2.trans hJ3) have hHsq : (reciprocalSum N)^2 ≤ 4*J^3 := by have hh := (sq_le_sq₀ hH0 (by positivity : 0 ≤ 2*J)).mpr hH nlinarith only [hh,hJ3] have hH3 : reciprocalSum N ≤ 2*J^3 := by linarith only [hH,hJ2,hJ3] have hNH2 := mul_le_mul_of_nonneg_left hHsq hN0 have hNH := mul_le_mul_of_nonneg_left hH3 hN0 have hNsmall := mul_le_mul_of_nonneg_left hJ13 hN0 have hW : (witnessExceptionBound N c : ℝ) ≤ 48*(N : ℝ)*J^3 := by dsimp only [J] exact_mod_cast witnessExceptionBound_le_natLog hcI change _ ≤ 512*(N : ℝ)*J^3 nlinarith only [hNH2,hNH,hNsmall,hN,hW] theorem one_sided_family_natLog_bound {N c L R : ℕ} {F : Finset (Finset ℕ)} {P T : Finset ℕ} (hcI : c ∈ Finset.Icc 1 N) (hcL : c ≤ L) (hLR : L ≤ R) (hRN : R ≤ N) (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, IsCrooked S → c ∈ S) (hP : P ∈ F) (hcP : c ∉ P) (hLP : ∀ x ∈ P, L ≤ x) (hT : T ∈ F) (hcT : c ∉ T) (hTR : ∀ x ∈ T, x ≤ R) (houtside : ∀ S ∈ F, c ∉ S → (∃ u ∈ S, u ≤ L) ∧ ∃ v ∈ S, R ≤ v) : (F.card : ℝ) ≤ (N : ℝ)^2/2-((L : ℝ)^2+((N : ℝ)-R)^2)/100+ 512*(N : ℝ)*((Nat.log 2 N : ℝ)+1)^3 := by have hN : 1 ≤ N := (Finset.mem_Icc.mp hcI).1.trans (Finset.mem_Icc.mp hcI).2 have hh := one_sided_family_finite_bound hN hcL hLR hRN hF hc hP hcP hLP hT hcT hTR houtside have herr := one_sided_error_le_natLog hcI linarith only [hh,herr] end /- OneSidedEndpointStability -/ /- Quantitative endpoint stability for near-extremal one-sided families. -/ section open Finset Filter theorem one_sided_endpoint_square_le {N c L R : ℕ} {F : Finset (Finset ℕ)} {P T : Finset ℕ} (hcI : c ∈ Finset.Icc 1 N) (hcL : c ≤ L) (hLR : L ≤ R) (hRN : R ≤ N) (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, IsCrooked S → c ∈ S) (hlarge : (N : ℝ)^2/2 ≤ (F.card : ℝ)+2048*N) (hP : P ∈ F) (hcP : c ∉ P) (hLP : ∀ x ∈ P, L ≤ x) (hT : T ∈ F) (hcT : c ∉ T) (hTR : ∀ x ∈ T, x ≤ R) (houtside : ∀ S ∈ F, c ∉ S → (∃ u ∈ S, u ≤ L) ∧ ∃ v ∈ S, R ≤ v) : (L+N-R)^2 ≤ 512000*N*(Nat.log 2 N+1)^3 := by have hh := one_sided_family_natLog_bound hcI hcL hLR hRN hF hc hP hcP hLP hT hcT hTR houtside have hNlog : N ≤ N*(Nat.log 2 N+1)^3 := Nat.le_mul_of_pos_right N (by positivity) have hNlogR : (N : ℝ) ≤ (N : ℝ)*((Nat.log 2 N : ℝ)+1)^3 := by exact_mod_cast hNlog have hsquare : ((L : ℝ)+(N-R))^2 ≤ 512000*(N : ℝ)*((Nat.log 2 N : ℝ)+1)^3 := by nlinarith only [hh,hlarge,hNlogR,sq_nonneg ((L : ℝ)-((N : ℝ)-R))] have hsub : ((L+N-R : ℕ) : ℝ) = (L : ℝ)+(N-R) := by rw [Nat.cast_sub (by omega : R ≤ L+N),Nat.cast_add] ring have hcast : (((L+N-R)^2 : ℕ) : ℝ) ≤ ((512000*N*(Nat.log 2 N+1)^3 : ℕ) : ℝ) := by simpa only [Nat.cast_pow,Nat.cast_mul,Nat.cast_ofNat,Nat.cast_add,Nat.cast_one,hsub] using hsquare exact_mod_cast hcast theorem eventually_one_sided_endpoint_stability (K : ℕ) : ∀ᶠ N : ℕ in atTop, ∀ (F : Finset (Finset ℕ)) (c L R : ℕ) (P T : Finset ℕ), c ∈ Finset.Icc 1 N → c ≤ L → L ≤ R → R ≤ N → Erdos272.IsArithInterSet N F → (∀ S ∈ F, IsCrooked S → c ∈ S) → (N : ℝ)^2/2 ≤ (F.card : ℝ)+2048*N → P ∈ F → c ∉ P → (∀ x ∈ P, L ≤ x) → T ∈ F → c ∉ T → (∀ x ∈ T, x ≤ R) → (∀ S ∈ F, c ∉ S → (∃ u ∈ S, u ≤ L) ∧ ∃ v ∈ S, R ≤ v) → K*(L+N-R)*(Nat.log 2 N+1) ≤ N := by filter_upwards [eventually_const_mul_natLog_pow_le (512000*K^2) 5] with N hlog F c L R P T hcI hcL hLR hRN hF hc hlarge hP hcP hLP hT hcT hTR houtside have hsquare := one_sided_endpoint_square_le hcI hcL hLR hRN hF hc hlarge hP hcP hLP hT hcT hTR houtside have hsq : (K*(L+N-R)*(Nat.log 2 N+1))^2 ≤ N^2 := by calc (K*(L+N-R)*(Nat.log 2 N+1))^2 = K^2*(Nat.log 2 N+1)^2*(L+N-R)^2 := by ring _ ≤ K^2*(Nat.log 2 N+1)^2*(512000*N*(Nat.log 2 N+1)^3) := Nat.mul_le_mul_left _ hsquare _ = N*((512000*K^2)*(Nat.log 2 N+1)^5) := by ring _ ≤ N*N := Nat.mul_le_mul_left N hlog _ = N^2 := by ring exact (Nat.pow_le_pow_iff_left (by decide : 2 ≠ 0)).mp hsq end /- HalfSizeAvoider -/ /- A progression avoiding the root and having a nonunit step limits crooked members. -/ section open Finset theorem noninterval_card_two_le {S : Finset ℕ} (hno : ¬IsInterval S) : 2 ≤ S.card := by by_contra hn by_cases hne : S.Nonempty · have hcard : S.card = 1 := by have hh := Finset.card_pos.mpr hne; omega obtain ⟨a,ha⟩ := Finset.card_eq_one.mp hcard exact hno ⟨a,a,by simpa only [Finset.Icc_self] using ha⟩ · have hS : S = ∅ := Finset.not_nonempty_iff_eq_empty.mp hne exact hno ⟨1,0,by simpa using hS⟩ theorem noninterval_progression_card_le_half {N : ℕ} {S : Finset ℕ} (hsub : S ⊆ Finset.Icc 1 N) (hAP : ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hno : ¬IsInterval S) : (S.card : ℝ) ≤ (N : ℝ)/2+1 := by have hcard := noninterval_card_two_le hno obtain ⟨l,hl⟩ := hAP obtain ⟨a,d,hd,hrep⟩ := nat_ap_eq_natAP hl hcard have hd2 : 2 ≤ d := by by_contra hn have hd1 : d = 1 := by omega apply hno rw [hrep,hd1] exact natAP_step_one_isInterval _ _ have hbS : a+(S.card-1)*d ∈ S := by have hh : a+(S.card-1)*d ∈ natAP a d S.card := mem_natAP.mpr ⟨S.card-1,by omega,rfl⟩ simpa only [← hrep] using hh have hbN := (Finset.mem_Icc.mp (hsub hbS)).2 have hmul := Nat.mul_le_mul_left (S.card-1) hd2 have hsubadd : S.card-1+1 = S.card := by omega have hsize : 2*S.card ≤ N+2 := by nlinarith only [hmul,hbN,hsubadd] have hsizeR : 2*(S.card : ℝ) ≤ (N : ℝ)+2 := by exact_mod_cast hsize linarith only [hsizeR] theorem meeting_half_set_pairs_card_le {N : ℕ} {P : Finset ℕ} (hN : 2 ≤ N) (hP : P ⊆ Finset.Icc 1 N) (hsize : (P.card : ℝ) ≤ (N : ℝ)/2+1) : ((((Finset.Icc 1 N).powersetCard 2).filter (fun Q => ¬Disjoint Q P)).card : ℝ) ≤ 3*(N : ℝ)^2/8+N := by let Q := Finset.Icc 1 N \ P have hpart : P.card+Q.card = N := by have hh := Finset.card_sdiff_add_card_eq_card hP rw [Nat.card_Icc,Nat.add_sub_cancel] at hh change Q.card+P.card = N at hh omega have hpartR : (P.card : ℝ)+Q.card = N := by exact_mod_cast hpart have hqN : (Q.card : ℝ) ≤ N := by have hh := Nat.cast_nonneg (α := ℝ) P.card; linarith only [hh,hpartR] have hq : (N : ℝ)/2-1 ≤ Q.card := by linarith only [hpartR,hsize] have hN' : (2 : ℝ) ≤ N := by exact_mod_cast hN have hqSq : ((N : ℝ)/2-1)^2 ≤ (Q.card : ℝ)^2 := (sq_le_sq₀ (by linarith only [hN']) (Nat.cast_nonneg _)).mpr hq have hcount := card_meeting_pairs_add (Finset.Icc 1 N) P rw [Nat.card_Icc,Nat.add_sub_cancel] at hcount have hcountR : ((((Finset.Icc 1 N).powersetCard 2).filter (fun Q => ¬Disjoint Q P)).card : ℝ)+ (Q.card.choose 2 : ℝ) = (N.choose 2 : ℝ) := by exact_mod_cast hcount rw [Nat.cast_choose_two,Nat.cast_choose_two] at hcountR nlinarith only [hcountR,hqSq,hqN,hN'] theorem crooked_with_half_size_avoider_card_le {N c : ℕ} {F C : Finset (Finset ℕ)} {P : Finset ℕ} (hN : 2 ≤ N) (hF : Erdos272.IsArithInterSet N F) (hCF : C ⊆ F) (hc : ∀ S ∈ C, c ∈ S) (hcrooked : ∀ S ∈ C, IsCrooked S) (hP : P ∈ F) (hcP : c ∉ P) (hsize : (P.card : ℝ) ≤ (N : ℝ)/2+1) : (C.card : ℝ) ≤ 3*(N : ℝ)^2/8+N+witnessExceptionBound N c := by classical let Good (S : Finset ℕ) := ∃ Q, IsWitnessPair S c Q ∧ ¬Disjoint Q P let G := C.filter Good let B := C.filter (fun S => ¬Good S) let Pool := ((Finset.Icc 1 N).powersetCard 2).filter (fun Q => ¬Disjoint Q P) have hGC : G ⊆ C := Finset.filter_subset _ _ have hBC : B ⊆ C := Finset.filter_subset _ _ have hB : B.card ≤ witnessExceptionBound N c := by apply restricted_witness_bad_family_card_le (admissible_subfamily hF (hBC.trans hCF)) (fun S hS => hc S (hBC hS)) (fun S hS => hcrooked S (hBC hS)) · intro S hS obtain ⟨z,hz⟩ := arithInter_inter_nonempty hF (hCF (hBC hS)) hP ⟨c,hc S (hBC hS)⟩ obtain ⟨hzS,hzP⟩ := Finset.mem_inter.mp hz exact ⟨z,Finset.mem_inter.mpr ⟨Finset.mem_erase.mpr ⟨fun heq => hcP (heq ▸ hzP),hzS⟩,hzP⟩⟩ · intro S hS Q hQ by_contra hn exact (Finset.mem_filter.mp hS).2 ⟨Q,hQ,hn⟩ have hG : G.card ≤ Pool.card := by have hh := private_pairs_and_intervals_card_le (E := ∅) (Pool := Pool) hF (hGC.trans hCF) (Finset.empty_subset _) (fun S hS => hc S (hGC hS)) (fun S hS => hcrooked S (hGC hS)) (by intro S hS obtain ⟨Q,hQ,hQP⟩ := (Finset.mem_filter.mp hS).2 have hQS : Q ⊆ Finset.Icc 1 N := hQ.2.1.trans ((Finset.erase_subset _ _).trans (Finset.mem_powerset.mp (hF.1 (hCF (hGC hS))))) exact ⟨Q,hQ,Finset.mem_filter.mpr ⟨Finset.mem_powersetCard.mpr ⟨hQS,hQ.1⟩,hQP⟩⟩) (by intro S hS; simp only [Finset.notMem_empty] at hS) simpa only [Finset.card_empty,Nat.add_zero] using hh have hpool := meeting_half_set_pairs_card_le hN (Finset.mem_powerset.mp (hF.1 hP)) hsize have hGR : (G.card : ℝ) ≤ Pool.card := by exact_mod_cast hG have hBR : (B.card : ℝ) ≤ witnessExceptionBound N c := by exact_mod_cast hB have hpart : (G.card : ℝ)+B.card = C.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := C) Good linarith only [hGR,hBR,hpart,hpool] end /- LowStartProgressionCount -/ /- Counting progression families all of whose first endpoints are small. -/ section open Finset theorem large_progressions_starting_low_card_le {N L : ℕ} {F : Finset (Finset ℕ)} (hLN : L ≤ N) (hF : Erdos272.IsArithInterSet N F) (hcard : ∀ S ∈ F, 0 < S.card) (hparam : ∀ S ∈ F, ∃ a d : ℕ, 0 < d ∧ d ≤ N ∧ S = natAP a d S.card ∧ a ≤ L) : (F.card : ℝ) ≤ (5/3)*(L : ℝ)*N+2*N*reciprocalSum N+N := by classical have hp : ∀ S : Finset ℕ, ∃ a d : ℕ, S ∈ F → 0 < d ∧ d ≤ N ∧ S = natAP a d S.card ∧ a ≤ L := by intro S by_cases hS : S ∈ F · obtain ⟨a,d,hh⟩ := hparam S hS exact ⟨a,d,fun _ => hh⟩ · exact ⟨0,1,fun hh => False.elim (hS hh)⟩ choose a d hspec using hp let I := F.filter (fun S => d S = 1) let B := F.filter (fun S => ¬d S = 1) have hIF : I ⊆ F := Finset.filter_subset _ _ have hBF : B ⊆ F := Finset.filter_subset _ _ have hI : I.card ≤ L*N := by have hcover : I ⊆ ((Finset.Icc 1 L).product (Finset.Icc 1 N)).image (fun p : ℕ × ℕ => Finset.Icc p.1 p.2) := by intro S hS obtain ⟨hSF,hd1⟩ := Finset.mem_filter.mp hS obtain ⟨_hd,_hdN,hrep,haL⟩ := hspec S hSF have hinterval : S = Finset.Icc (a S) (a S+(S.card-1)) := by calc S = natAP (a S) (d S) S.card := hrep _ = _ := by rw [hd1,natAP_one_eq_Icc (hcard S hSF)] have hab : a S ≤ a S+(S.card-1) := Nat.le_add_right _ _ have haS : a S ∈ S := by have hh : a S ∈ Finset.Icc (a S) (a S+(S.card-1)) := Finset.mem_Icc.mpr ⟨le_rfl,hab⟩ simpa only [← hinterval] using hh have hbS : a S+(S.card-1) ∈ S := by have hh : a S+(S.card-1) ∈ Finset.Icc (a S) (a S+(S.card-1)) := Finset.mem_Icc.mpr ⟨hab,le_rfl⟩ simpa only [← hinterval] using hh have ha1 := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 hSF) haS)).1 have hbI := Finset.mem_powerset.mp (hF.1 hSF) hbS exact Finset.mem_image.mpr ⟨(a S,a S+(S.card-1)),Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨ha1,haL⟩,hbI⟩,hinterval.symm⟩ have hh := (Finset.card_le_card hcover).trans Finset.card_image_le simpa only [Finset.product_eq_sprod,Finset.card_product,Nat.card_Icc,Nat.add_sub_cancel] using hh have hB := large_step_endpoint_rectangle_card_le (R := 0) hLN (Nat.zero_le N) (admissible_subfamily hF hBF) (fun S hS => hcard S (hBF hS)) (by intro S hS obtain ⟨hSF,hd1⟩ := Finset.mem_filter.mp hS obtain ⟨hd,hdN,hrep,haL⟩ := hspec S hSF exact ⟨a S,d S,by omega,hdN,hrep,haL,Nat.zero_le _⟩) have hIR : (I.card : ℝ) ≤ (L : ℝ)*N := by exact_mod_cast hI have hpart : (I.card : ℝ)+B.card = F.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := F) (fun S => d S = 1) norm_num only [Nat.cast_zero,sub_zero] at hB linarith only [hB,hIR,hpart] theorem progressions_starting_low_card_le {N L : ℕ} {F : Finset (Finset ℕ)} (hLN : L ≤ N) (hF : Erdos272.IsArithInterSet N F) (hAP : ∀ S ∈ F, ∃ l : ℕ∞, (S : Set ℕ).IsAPOfLength l) (hlow : ∀ S ∈ F, ∃ u ∈ S, u ≤ L) : (F.card : ℝ) ≤ (5/3)*(L : ℝ)*N+2*N*reciprocalSum N+19*N+3 := by classical let A := F.filter (fun S => 4 ≤ S.card) let B := F.filter (fun S => ¬4 ≤ S.card) have hAF : A ⊆ F := Finset.filter_subset _ _ have hBF : B ⊆ F := Finset.filter_subset _ _ have hA := large_progressions_starting_low_card_le hLN (admissible_subfamily hF hAF) (fun S hS => by have hh := (Finset.mem_filter.mp hS).2; omega) (by intro S hS have hsize := (Finset.mem_filter.mp hS).2 obtain ⟨l,hl⟩ := hAP S (hAF hS) obtain ⟨a,d,hd,hrep⟩ := nat_ap_eq_natAP hl (by omega : 2 ≤ S.card) have hstep : a+d ∈ S := by have hh : a+d ∈ natAP a d S.card := mem_natAP.mpr ⟨1,by omega,by simp⟩ simpa only [← hrep] using hh have hdN : d ≤ N := by have hh := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hF.1 (hAF hS)) hstep)).2 omega obtain ⟨u,hu,huL⟩ := hlow S (hAF hS) have hau := (natAP_bounds_of_mem (hrep ▸ hu)).1 exact ⟨a,d,hd,hdN,hrep,hau.trans huL⟩) have hB := progression_family_small_card_le (admissible_subfamily hF hBF) (fun S hS => hAP S (hBF hS)) (fun S hS => by have hh := (Finset.mem_filter.mp hS).2; omega) have hBR : (B.card : ℝ) ≤ 18*(N : ℝ)+3 := by exact_mod_cast hB have hpart : (A.card : ℝ)+B.card = F.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := F) (fun S => 4 ≤ S.card) linarith only [hA,hBR,hpart] end /- LowStartIntervalReduction -/ /- Small first endpoints force avoiding progressions to be ordinary intervals. -/ section open Finset Filter theorem noninterval_avoider_low_start_finite_bound {N c L : ℕ} {F : Finset (Finset ℕ)} {P : Finset ℕ} (hN : 2 ≤ N) (hLN : L ≤ N) (hF : Erdos272.IsArithInterSet N F) (hc : ∀ S ∈ F, IsCrooked S → c ∈ S) (hlow : ∀ S ∈ F, ∃ u ∈ S, u ≤ L) (hP : P ∈ F) (hcP : c ∉ P) (hno : ¬IsInterval P) : (F.card : ℝ) ≤ 3*(N : ℝ)^2/8+(5/3)*(L : ℝ)*N+ 2*N*reciprocalSum N+20*N+3+witnessExceptionBound N c := by classical let C := F.filter IsCrooked let A := F.filter (fun S => ¬IsCrooked S) have hCF : C ⊆ F := Finset.filter_subset _ _ have hAF : A ⊆ F := Finset.filter_subset _ _ have hPAP : ∃ l : ℕ∞, (P : Set ℕ).IsAPOfLength l := by by_contra hn exact hcP (hc P hP hn) have hsize := noninterval_progression_card_le_half (Finset.mem_powerset.mp (hF.1 hP)) hPAP hno have hC := crooked_with_half_size_avoider_card_le hN hF hCF (fun S hS => hc S (hCF hS) (Finset.mem_filter.mp hS).2) (fun S hS => (Finset.mem_filter.mp hS).2) hP hcP hsize have hA := progressions_starting_low_card_le hLN (admissible_subfamily hF hAF) (fun S hS => of_not_not (Finset.mem_filter.mp hS).2) (fun S hS => hlow S (hAF hS)) have hpart : (C.card : ℝ)+A.card = F.card := by exact_mod_cast Finset.card_filter_add_card_filter_not (s := F) IsCrooked linarith only [hC,hA,hpart] theorem eventually_low_start_interval_avoiders : ∀ᶠ N : ℕ in atTop, ∀ (F : Finset (Finset ℕ)) (c L : ℕ), c ∈ Finset.Icc 1 N → 256*L ≤ N → Erdos272.IsArithInterSet N F → (∀ S ∈ F, IsCrooked S → c ∈ S) → (∀ S ∈ F, ∃ u ∈ S, u ≤ L) → (N : ℝ)^2/2 ≤ (F.card : ℝ)+2048*N → ∀ P ∈ F, c ∉ P → IsInterval P := by filter_upwards [eventually_const_mul_natLog_pow_le 16384 3,Filter.eventually_ge_atTop 65536] with N hlog hN F c L hcI hsmall hF hc hlow hlarge P hP hcP by_contra hno have hLN : L ≤ N := by omega have hh := noninterval_avoider_low_start_finite_bound (by omega : 2 ≤ N) hLN hF hc hlow hP hcP hno have herr := one_sided_error_le_natLog hcI have hH := reciprocalSum_nonneg N have hN0 := Nat.cast_nonneg (α := ℝ) N have hNH := mul_nonneg hN0 hH have hNH2 := mul_nonneg hN0 (sq_nonneg (reciprocalSum N)) have hbound : (F.card : ℝ) ≤ 3*(N : ℝ)^2/8+(5/3)*(L : ℝ)*N+ 512*(N : ℝ)*((Nat.log 2 N : ℝ)+1)^3 := by nlinarith only [hh,herr,hNH,hNH2,hN0] have hsmallR : 256*(L : ℝ) ≤ N := by exact_mod_cast hsmall have hsmallMul := mul_le_mul_of_nonneg_right hsmallR hN0 have hlogR : 16384*((Nat.log 2 N : ℝ)+1)^3 ≤ (N : ℝ) := by exact_mod_cast hlog have hlogMul := mul_le_mul_of_nonneg_right hlogR hN0 have hgap : (F.card : ℝ) ≤ 7*(N : ℝ)^2/16 := by nlinarith only [hbound,hsmallMul,hlogMul,sq_nonneg (N : ℝ)] have hNR : (65536 : ℝ) ≤ N := by exact_mod_cast hN have hNmul := mul_le_mul_of_nonneg_right hNR hN0 nlinarith only [hgap,hlarge,hNR,hNmul] end /- StructuralReductionComplete -/ /- Completion of the structural reduction and the exact Szabo-strong target. -/ section open Finset Filter theorem eventually_structural_reduction : ∀ᶠ N : ℕ in atTop, ∀ F : Finset (Finset ℕ), Erdos272.IsArithInterSet N F → (N : ℝ)^2/2 ≤ (F.card : ℝ) → ∃ G : Finset (Finset ℕ), Erdos272.IsArithInterSet N G ∧ F.card ≤ G.card+2048*N ∧ ReducedFamilyStructure N G := by classical filter_upwards [eventually_right_avoider_crooked_reduction, eventually_one_sided_endpoint_stability 256,eventually_low_start_interval_avoiders, Filter.eventually_ge_atTop 10000] with N hreduce hstable hinterval hN F hF hlarge obtain ⟨G,hG,hFG,c,hcI,hcG,hcase⟩ := hreduce F hF hlarge have hFGR : (F.card : ℝ) ≤ G.card+2048*N := by exact_mod_cast hFG have hlargeG : (N : ℝ)^2/2 ≤ (G.card : ℝ)+2048*N := hlarge.trans hFGR refine ⟨G,hG,hFG,?_⟩ rcases hcase with hcommon | hright · exact Or.inl ⟨c,hcommon⟩ · have hnonempty := admissible_member_nonempty_of_card_two_le hG (near_extremal_card_two_le hN hlargeG) obtain ⟨L,R,hcL,hLR,hRN,⟨P,hP,hcP,hLP⟩,⟨T,hT,hcT,hTR⟩,hend⟩ := outside_member_envelope hG hnonempty hright have houtside : ∀ S ∈ G, c ∉ S → (∃ u ∈ S, u ≤ L) ∧ ∃ v ∈ S, R ≤ v := by intro S hS hcS obtain ⟨⟨u,hu,huL,_humin⟩,v,hv,hRv,_hvmax⟩ := hend S hS hcS exact ⟨⟨u,hu,huL⟩,v,hv,hRv⟩ have hsmall := hstable G c L R P T hcI hcL.le hLR hRN hG hcG hlargeG hP hcP hLP hT hcT hTR houtside have hLsmall : 256*L ≤ N := by have hbase : 256*(L+N-R) ≤ 256*(L+N-R)*(Nat.log 2 N+1) := Nat.le_mul_of_pos_right _ (by omega) exact (Nat.mul_le_mul_left 256 (show L ≤ L+N-R by omega)).trans (hbase.trans hsmall) have hlow : ∀ S ∈ G, ∃ u ∈ S, u ≤ L := by intro S hS by_cases hcS : c ∈ S · exact ⟨c,hcS,hcL.le⟩ · exact (houtside S hS hcS).1 have hallInterval := hinterval G c L hcI hLsmall hG hcG hlow hlargeG refine Or.inr ⟨c,L,R,hcL,hLR,hRN,hsmall,?_⟩ intro S hS hcS obtain ⟨a,b,hrep⟩ := hallInterval S hS hcS obtain ⟨⟨u,hu,huL⟩,v,hv,hRv⟩ := houtside S hS hcS have huI := Finset.mem_Icc.mp (hrep ▸ hu) have hvI := Finset.mem_Icc.mp (hrep ▸ hv) have haL : a ≤ L := huI.1.trans huL have hRb : R ≤ b := hRv.trans hvI.2 have hab : a ≤ b := haL.trans (hLR.trans hRb) have hca : c < a := by by_contra hn apply hcS rw [hrep] exact Finset.mem_Icc.mpr ⟨by omega,by omega⟩ have hbS : b ∈ S := by rw [hrep]; exact Finset.mem_Icc.mpr ⟨hab,le_rfl⟩ have hbN := (Finset.mem_Icc.mp (Finset.mem_powerset.mp (hG.1 hS) hbS)).2 exact ⟨a,b,hca,haL,hRb,hbN,hrep⟩ theorem structural_reduction : StructuralReduction := by obtain ⟨N₀,hN₀⟩ := Filter.eventually_atTop.mp eventually_structural_reduction exact ⟨N₀,hN₀⟩ theorem target : fcTypeOfName% "Erdos272.erdos_272.variants.szabo_strong" := by exact target_of_structural_reduction structural_reduction end