From 7aeacb2323354535ec03bc7cf622fbee8abfbc24 Mon Sep 17 00:00:00 2001 From: Gabriel Dahia Date: Sun, 8 Nov 2026 18:29:09 +0100 Subject: [PATCH] =?UTF-8?q?Import=20Fox=E2=80=93Lov=C3=A1sz=20arithmetic?= =?UTF-8?q?=20triangle=20removal=20in=20vector=20spaces?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Import the formalization of Fox and Lovász, "A tight bound for Green's arithmetic triangle removal lemma in vector spaces" (arXiv:1606.01230), from gdahia/ArithmeticTriangleRemovalInVectorSpaces at 3bddc92: the removal lemma in F_p^n with exponent C_p, the Kleinberg–Sawin–Speyer bound, the count of triangles spanned by vertex-disjoint triangles, and the tightness of C_p via Pebody's coupling and the KSS construction. The library moves under LeanPool.ArithmeticTriangleRemovalInVectorSpaces with its imports rewritten. The Palomar Challenge and Solution modules are left out, since Solution only restates the library theorems. Co-Authored-By: Claude Opus 5.5 --- ...ithmeticTriangleRemovalInVectorSpaces.lean | 32 ++ .../Construction/Behrend.lean | 51 ++ .../Construction/Family.lean | 223 ++++++++ .../Construction/Hash.lean | 440 +++++++++++++++ .../Construction/LowerBound.lean | 434 +++++++++++++++ .../Construction/TypeClass.lean | 200 +++++++ .../Coupling/Basic.lean | 232 ++++++++ .../Coupling/Decomposition.lean | 309 +++++++++++ .../Coupling/Decreasing.lean | 151 ++++++ .../Coupling/Peeling.lean | 351 ++++++++++++ .../Coupling/Uniform.lean | 334 ++++++++++++ .../DisjointTriangles/Embedding.lean | 166 ++++++ .../DisjointTriangles/MaximalFamily.lean | 137 +++++ .../DisjointTriangles/Pruning.lean | 274 ++++++++++ .../DisjointTriangles/Sampling.lean | 500 ++++++++++++++++++ .../DisjointTriangles/TensorPower.lean | 110 ++++ .../Imports.lean | 36 ++ .../LinearMap/Card.lean | 67 +++ .../MulticoloredSumFree/Basic.lean | 71 +++ .../MulticoloredSumFree/Exponent.lean | 166 ++++++ .../MulticoloredSumFree/Monomials.lean | 68 +++ .../MulticoloredSumFree/Product.lean | 189 +++++++ .../MulticoloredSumFree/SliceRank.lean | 181 +++++++ .../MulticoloredSumFree/SmallPrimes.lean | 117 ++++ .../MulticoloredSumFree/TensorPower.lean | 95 ++++ .../SliceRank/Diagonal.lean | 130 +++++ .../Tightness/Exponent.lean | 147 +++++ .../Triangle/Basic.lean | 110 ++++ .../ZMod.lean | 208 ++++++++ ...tic-triangle-removal-in-vector-spaces.yaml | 67 +++ 30 files changed, 5596 insertions(+) create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/Behrend.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/Family.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/Hash.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/LowerBound.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/TypeClass.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Basic.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Decomposition.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Decreasing.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Peeling.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Uniform.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/Embedding.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/MaximalFamily.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/Pruning.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/Sampling.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/TensorPower.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Imports.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/LinearMap/Card.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Basic.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Exponent.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Monomials.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Product.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/SliceRank.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/SmallPrimes.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/TensorPower.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/SliceRank/Diagonal.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Tightness/Exponent.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Triangle/Basic.lean create mode 100644 LeanPool/ArithmeticTriangleRemovalInVectorSpaces/ZMod.lean create mode 100644 LeanPool/projects/arithmetic-triangle-removal-in-vector-spaces.yaml diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces.lean new file mode 100644 index 0000000000..7ddc30bd14 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces.lean @@ -0,0 +1,32 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.ZMod + +/-! +# A tight bound for Green's arithmetic triangle removal lemma in vector spaces + +Source: arxiv:1606.01230, url:https://github.com/gdahia/ArithmeticTriangleRemovalInVectorSpaces/tree/3bddc92e8027badc994ba8993f7c625e60c7b13a +Authors: Gabriel Dahia +Status: verified +Main declarations: + `ArithmeticTriangleRemovalInVectorSpaces.exists_subset_card_sdiff_add_le_forall_add_ne_zero`, + `ArithmeticTriangleRemovalInVectorSpaces.card_le_rpow_one_sub_c_mul`, + `ArithmeticTriangleRemovalInVectorSpaces.div_pow_rpow_C_mul_sq_le_card_triangles`, + `ArithmeticTriangleRemovalInVectorSpaces.le_rpow_C_sub_of_forall_exists_subset` +Tags: additive-combinatorics, removal-lemma, slice-rank, finite-fields, sum-free-sets +MSC: 11B30, 05D40, 11T99 +-/ + +/-! +## Upstream attribution + +Adapted for Lean Pool from upstream commit `3bddc92e8027badc994ba8993f7c625e60c7b13a` by +moving the library under `LeanPool.ArithmeticTriangleRemovalInVectorSpaces`. The upstream +Palomar `Challenge` and `Solution` modules are omitted: `Solution` only restates the theorems of +`LeanPool.ArithmeticTriangleRemovalInVectorSpaces.ZMod` under primed names. +-/ diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/Behrend.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/Behrend.lean new file mode 100644 index 0000000000..8411d0500b --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/Behrend.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import Mathlib.Analysis.SpecialFunctions.Log.Basic +public import Mathlib.Combinatorics.Additive.AP.Three.Defs +import Mathlib.Combinatorics.Additive.AP.Three.Behrend + +/-! +# Large sets without arithmetic progressions in `ZMod P` + +Behrend's construction, `Behrend.roth_lower_bound` in Mathlib, gives a subset of +`range ((P + 1) / 2)` without three-term arithmetic progressions and with at least +`P / 2 * exp (-4 * √(log P))` elements. Its image in `ZMod P` has no three-term arithmetic +progressions either, since sums of two of its elements do not wrap around. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.exists_threeAPFree_le_card_zmod`: the set in `ZMod P`. +-/ + +public section + +open Finset Real + +namespace ArithmeticTriangleRemovalInVectorSpaces + +/-- **Behrend's construction in `ZMod P`.** There is a set `S` in `ZMod P` without three-term +arithmetic progressions and with at least `P / 2 * exp (-4 * √(log P))` elements. -/ +lemma exists_threeAPFree_le_card_zmod {P : ℕ} (hP : 0 < P) : + ∃ S : Finset (ZMod P), ThreeAPFree (S : Set (ZMod P)) ∧ P / 2 * exp (-4 * √(log P)) ≤ #S := by + obtain ⟨t, ht, hcard, hfree⟩ := rothNumberNat_spec ((P + 1) / 2) + have hinj := CharP.natCast_injOn_Iio (ZMod P) P + refine ⟨t.image Nat.cast, ?_, ?_⟩ + · push_cast + refine hfree.image' (Nat.castAddMonoidHom (ZMod P)) (hinj.mono ?_) + rintro _ ⟨a, ha, b, hb, rfl⟩ + grind [mem_range.1 (ht ha), mem_range.1 (ht hb)] + · rw [card_image_of_injOn (hinj.mono fun a ha ↦ by grind [mem_range.1 (ht ha)]), hcard] + grw [← Behrend.roth_lower_bound] + rw [neg_mul, neg_mul] + gcongr + · rw [div_le_iff₀ two_pos] + exact_mod_cast (by grind : P ≤ (P + 1) / 2 * 2) + · exact_mod_cast (by grind : 0 < (P + 1) / 2) + · exact_mod_cast (by grind : (P + 1) / 2 ≤ P) + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/Family.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/Family.lean new file mode 100644 index 0000000000..41e7d70ee0 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/Family.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Construction.TypeClass +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Basic +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Construction.Behrend +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Construction.Hash +import Mathlib.NumberTheory.Bertrand + +/-! +# The sum-free family of a base point + +Let `a₀`, `b₀` and `c₀` be vectors in `Fin n → ℕ` with `a₀ r + b₀ r + c₀ r = p - 1` for every `r`. +The triples `(a, b, c)` with `a`, `b` and `c` in the type classes of `a₀`, `b₀` and `c₀` and +`a r + b r + c r = p - 1` for every `r` are permuted transitively in each coordinate, so each +vector lies in equally many of them. Hashing them with a prime `P` chosen by Bertrand's postulate +into a set chosen by Behrend's construction gives a multicolored sum-free family nearly as large as +the smallest of the three type classes. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.permTriple σ v`: the triple `v` with the entries of its + three vectors permuted by `σ`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.card_filter_mul_card_typeClass_eq`: the fibers of a + projection compatible with the permutations all have the same size. +* `ArithmeticTriangleRemovalInVectorSpaces.exists_isMulticoloredSumFree_mul_exp_le`: hashing with + a prime from Bertrand's postulate into a set from Behrend's construction. +* `ArithmeticTriangleRemovalInVectorSpaces.exists_isMulticoloredSumFree_of_typeClass`: a + multicolored sum-free family in `Fin n → ZMod p` with at least + `w * exp (-4 * √(log ((12 + 2 * p) * p ^ (3 * n)))) / (4 * (12 + 2 * p))` members, where `w` is + at most the size of each type class. +-/ + +public section + +open Finset Real + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {n p : ℕ} + +/-- Permuting the entries of the three vectors of a triple simultaneously. -/ +private def permTriple (σ : Equiv.Perm (Fin n)) : + (Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ) → (Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ) + | (a, b, c) => (a ∘ σ, b ∘ σ, c ∘ σ) + +private lemma permTriple_permTriple (σ τ : Equiv.Perm (Fin n)) + (v : (Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ)) : + permTriple σ (permTriple τ v) = permTriple (τ * σ) v := + rfl + +private lemma permTriple_one (v : (Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ)) : permTriple 1 v = v := + rfl + +/-- **Equal fibers.** If permutations act on `V` compatibly with a map `g` into the type class of +`w₀`, then every fiber of `g` over the type class has `#V / #(typeClass w₀)` elements. -/ +private lemma card_filter_mul_card_typeClass_eq + {V : Finset ((Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ))} + {w₀ : Fin n → ℕ} (g : (Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ) → Fin n → ℕ) + (hg : ∀ σ v, g (permTriple σ v) = g v ∘ σ) (hgV : ∀ v ∈ V, g v ∈ typeClass w₀) + (hV : ∀ σ, ∀ v ∈ V, permTriple σ v ∈ V) {w : Fin n → ℕ} (hw : w ∈ typeClass w₀) : + #{v ∈ V | g v = w} * #(typeClass w₀) = #V := by + rw [card_eq_sum_card_fiberwise hgV, sum_const_nat, mul_comm] + intro w' hw' + obtain ⟨σ, rfl⟩ := exists_eq_comp_of_mem_typeClass hw hw' + refine card_nbij' (permTriple σ⁻¹) (permTriple σ) ?_ ?_ ?_ ?_ + · intro v hv + simp only [coe_filter, Set.mem_ofPred_eq] at hv ⊢ + obtain ⟨hvV, hvg⟩ := hv + refine ⟨hV σ⁻¹ v hvV, ?_⟩ + rw [hg, hvg] + ext r + simp + · intro v hv + simp only [coe_filter, Set.mem_ofPred_eq] at hv ⊢ + obtain ⟨hvV, hvg⟩ := hv + exact ⟨hV σ v hvV, by rw [hg, hvg]⟩ + · intro v _ + rw [permTriple_permTriple, inv_mul_cancel, permTriple_one] + · intro v _ + rw [permTriple_permTriple, mul_inv_cancel, permTriple_one] + +variable {a₀ b₀ c₀ : Fin n → ℕ} + +private lemma permTriple_mem_vecSumTriples (σ : Equiv.Perm (Fin n)) + {v : (Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ)} + (hv : v ∈ vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀)) : + permTriple σ v ∈ vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀) := by + obtain ⟨a, b, c⟩ := v + obtain ⟨ha, hb, hc, hsum⟩ := mk_mem_vecSumTriples.1 hv + exact mk_mem_vecSumTriples.2 ⟨comp_mem_typeClass ha σ, comp_mem_typeClass hb σ, + comp_mem_typeClass hc σ, fun r ↦ hsum (σ r)⟩ + +private lemma sum_add_add_eq (h₀ : ∀ r, a₀ r + b₀ r + c₀ r = p - 1) {a b c : Fin n → ℕ} + (ha : a ∈ typeClass a₀) (hb : b ∈ typeClass b₀) (hc : c ∈ typeClass c₀) : + ∑ r, (a r + b r + c r) = n * (p - 1) := by + rw [sum_add_distrib, sum_add_distrib, sum_eq_of_mem_typeClass ha, sum_eq_of_mem_typeClass hb, + sum_eq_of_mem_typeClass hc, ← sum_add_distrib, ← sum_add_distrib] + simp [h₀] + +private lemma card_typeClass_le_card_vecSumTriples (h₀ : ∀ r, a₀ r + b₀ r + c₀ r = p - 1) : + #(typeClass a₀) ≤ #(vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀)) := by + rw [← card_filter_mul_card_typeClass_eq (fun (a, _, _) ↦ a) (fun _ _ ↦ rfl) + (by simp +contextual) (fun σ _ ↦ permTriple_mem_vecSumTriples σ) (self_mem_typeClass a₀)] + refine Nat.le_mul_of_pos_left _ (card_pos.2 ⟨(a₀, b₀, c₀), ?_⟩) + simpa using ⟨self_mem_typeClass a₀, self_mem_typeClass b₀, self_mem_typeClass c₀, h₀⟩ + +/-- If `0 < w` is at most the size of each type class, then at most +`3 * (#V / w)` triples of `V = vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀)` share +a vector with a given one. -/ +private lemma card_filter_shares_le {w : ℝ} (hw : 0 < w) (hwa : w ≤ #(typeClass a₀)) + (hwb : w ≤ #(typeClass b₀)) (hwc : w ≤ #(typeClass c₀)) + {v : (Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ)} + (hv : v ∈ vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀)) : + #{v' ∈ vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀) | Shares v v'} ≤ + 3 * (#(vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀)) / w) := by + have hfib {w₀ : Fin n → ℕ} (g : (Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ) → Fin n → ℕ) + (hg : ∀ σ v, g (permTriple σ v) = g v ∘ σ) + (hgV : ∀ v ∈ vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀), + g v ∈ typeClass w₀) + (hw₀ : w ≤ #(typeClass w₀)) {x : Fin n → ℕ} (hx : x ∈ typeClass w₀) : + #{v ∈ vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀) | g v = x} ≤ + #(vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀)) / w := by + rw [le_div_iff₀ hw, ← card_filter_mul_card_typeClass_eq g hg hgV + (fun σ _ ↦ permTriple_mem_vecSumTriples σ) hx] + push_cast + gcongr + obtain ⟨a, b, c⟩ := v + obtain ⟨ha, hb, hc, -⟩ := mk_mem_vecSumTriples.1 hv + have hsub : {v' ∈ vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀) | + Shares (a, b, c) v'} ⊆ + {v' ∈ vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀) | + (fun (a', _, _) ↦ a') v' = a} ∪ + {v' ∈ vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀) | + (fun (_, b', _) ↦ b') v' = b} ∪ + {v' ∈ vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀) | + (fun (_, _, c') ↦ c') v' = c} := by + rintro ⟨a', b', c'⟩ + simp only [mem_filter, mem_union, shares_mk] + grind + grw [card_le_card hsub, card_union_le, card_union_le] + push_cast + linarith [hfib (fun (a, _, _) ↦ a) (fun _ _ ↦ rfl) (by simp +contextual) hwa ha, + hfib (fun (_, b, _) ↦ b) (fun _ _ ↦ rfl) (by simp +contextual) hwb hb, + hfib (fun (_, _, c) ↦ c) (fun _ _ ↦ rfl) (by simp +contextual) hwc hc] + +/-- Hashing `vecSumTriples p A B C` with a prime `P ≤ 2 * (2 * F + p)` from Bertrand's postulate +into a set from Behrend's construction gives a multicolored sum-free family with at least +`#V * exp (-4 * √(log P)) / (4 * P)` members, if at most `F` triples share a vector with a given +one. -/ +private lemma exists_isMulticoloredSumFree_mul_exp_le {A B C : Finset (Fin n → ℕ)} (hp : 2 ≤ p) + (hsum : ∀ a ∈ A, ∀ b ∈ B, ∀ c ∈ C, ∑ r, (a r + b r + c r) = n * (p - 1)) {F : ℝ} + (hF₀ : 0 ≤ F) + (hF : ∀ v ∈ vecSumTriples p A B C, #{v' ∈ vecSumTriples p A B C | Shares v v'} ≤ F) : + ∃ (P m : ℕ) (x y z : Fin m → Fin n → ZMod p), IsMulticoloredSumFree x y z ∧ 0 < P ∧ + P ≤ 2 * (2 * F + p) ∧ #(vecSumTriples p A B C) * exp (-4 * √(log P)) ≤ 4 * m * P := by + obtain ⟨P, hP, hPlt, hPle⟩ := Nat.exists_prime_lt_and_le_two_mul (2 * ⌊F⌋₊ + p) (by grind) + have := Fact.mk hP + obtain ⟨S, hS, hScard⟩ := exists_threeAPFree_le_card_zmod hP.pos + obtain ⟨m, x, y, z, hsf, hm⟩ := exists_isMulticoloredSumFree_of_hash hp (by grind) hsum + (fun v hv ↦ Nat.le_floor (hF v hv)) hS + refine ⟨P, m, x, y, z, hsf, hP.pos, ?_, ?_⟩ + · grw [hPle] + push_cast + grw [Nat.floor_le hF₀] + · have hPF : (P : ℝ) / 2 ≤ P - ⌊F⌋₊ := by + rw [le_sub_comm, sub_half, le_div_iff₀ two_pos] + exact_mod_cast (by grind : ⌊F⌋₊ * 2 ≤ P) + have h : #(vecSumTriples p A B C) * (P / 2 * exp (-4 * √(log P))) * (P / 2) ≤ m * P ^ 3 := by + grw [hScard, hPF] + exact hm + refine le_of_mul_le_mul_right ?_ (pow_pos (by exact_mod_cast hP.pos : (0 : ℝ) < P) 2) + linarith + +/-- **The sum-free family of a base point.** If `a₀ r + b₀ r + c₀ r = p - 1` for every `r` and +`1 ≤ w` is at most the size of the type classes of `a₀`, `b₀` and `c₀`, then there is a +multicolored sum-free family in `Fin n → ZMod p` with at least +`w * exp (-4 * √(log ((12 + 2 * p) * p ^ (3 * n)))) / (4 * (12 + 2 * p))` members. -/ +lemma exists_isMulticoloredSumFree_of_typeClass (hp : 2 ≤ p) + (h₀ : ∀ r, a₀ r + b₀ r + c₀ r = p - 1) {w : ℝ} (hw : 1 ≤ w) (hwa : w ≤ #(typeClass a₀)) + (hwb : w ≤ #(typeClass b₀)) (hwc : w ≤ #(typeClass c₀)) : + ∃ (m : ℕ) (x y z : Fin m → Fin n → ZMod p), IsMulticoloredSumFree x y z ∧ + w * exp (-4 * √(log ((12 + 2 * p) * p ^ (3 * n)))) / (4 * (12 + 2 * p)) ≤ m := by + obtain ⟨P, m, x, y, z, hsf, hP, hPle, hm⟩ := exists_isMulticoloredSumFree_mul_exp_le hp + (fun a ha b hb c hc ↦ sum_add_add_eq h₀ ha hb hc) (by positivity) + (fun v hv ↦ card_filter_shares_le (by positivity) hwa hwb hwc hv) + refine ⟨m, x, y, z, hsf, ?_⟩ + have hwV : w ≤ #(vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀)) := + hwa.trans (by exact_mod_cast card_typeClass_le_card_vecSumTriples h₀) + have hPV : (P : ℝ) ≤ + (12 + 2 * p) * (#(vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀)) / w) := by + nlinarith [(one_le_div (by positivity)).2 hwV] + have hE : exp (-4 * √(log ((12 + 2 * p) * p ^ (3 * n)))) ≤ exp (-4 * √(log P)) := by + rw [exp_le_exp, neg_mul, neg_mul, neg_le_neg_iff] + gcongr + grw [hPV, div_le_self (by positivity) hw, card_vecSumTriples_le, + card_typeClass_le (p := p) (fun r ↦ by grind [h₀ r]), + card_typeClass_le (p := p) (fun r ↦ by grind [h₀ r]), + card_typeClass_le (p := p) (fun r ↦ by grind [h₀ r])] + push_cast + exact le_of_eq (by ring) + rw [div_le_iff₀ (by positivity)] + calc w * exp (-4 * √(log ((12 + 2 * p) * p ^ (3 * n)))) + ≤ w * exp (-4 * √(log P)) := by grw [hE] + _ = w * (#(vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀)) * + exp (-4 * √(log P))) / #(vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀)) := by + field_simp [(by linarith : (0 : ℝ) < #(vecSumTriples p (typeClass a₀) (typeClass b₀) + (typeClass c₀))).ne'] + _ ≤ w * (4 * m * ((12 + 2 * p) * + (#(vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀)) / w))) / + #(vecSumTriples p (typeClass a₀) (typeClass b₀) (typeClass c₀)) := by grw [hm, hPV] + _ = m * (4 * (12 + 2 * p)) := by + field_simp [(by linarith : (0 : ℝ) < #(vecSumTriples p (typeClass a₀) (typeClass b₀) + (typeClass c₀))).ne'] + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/Hash.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/Hash.lean new file mode 100644 index 0000000000..b3a6906a7f --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/Hash.lean @@ -0,0 +1,440 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Basic +public import Mathlib.Basic.Real.Basic +public import Mathlib.Combinatorics.Additive.AP.Three.Defs +import Mathlib.Algebra.Field.ZMod +import Mathlib.Combinatorics.Enumerative.DoubleCounting +import Mathlib.Data.Matrix.Mul +import Mathlib.Data.Rat.Cast.Order +import Mathlib.Tactic.Linarith.Frontend +import Mathlib.Tactic.LinearCombination +import Mathlib.Tactic.NormNum.Abs +import Mathlib.Tactic.NormNum.DivMod +import Mathlib.Tactic.NormNum.OfScientific +import Mathlib.Tactic.Positivity.Finset +import Mathlib.Tactic.Ring.RingNF + +/-! +# Hashing triples into a set without arithmetic progressions + +Let `A`, `B` and `C` be sets of vectors in `Fin n → ℕ`, and let `V` be the set of the triples +`(a, b, c)` in `A ×ˢ B ×ˢ C` with `a r + b r + c r = p - 1` for every `r`. A hash `(h, α, β)` with +values in `ZMod P` sends `a` to `β + h ⬝ᵥ a` and `c` to `α + h ⬝ᵥ c`. The triples whose two hashes +agree and lie in a set `S` without three-term arithmetic progressions, and which share no vector +with another such triple, form a multicolored sum-free family. Averaging over all hashes gives one +where this family is large. This is the construction of Section 4 of Kleinberg, Sawin and Speyer. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.vecSumTriples p A B C`: the triples `(a, b, c)` of + `A ×ˢ B ×ˢ C` with `a r + b r + c r = p - 1` for every `r`. +* `ArithmeticTriangleRemovalInVectorSpaces.Shares v v'`: the triples `v` and `v'` agree in some + coordinate. +* `ArithmeticTriangleRemovalInVectorSpaces.hashedTriples V S θ`: the triples of `V` whose hashes + under `θ` agree and lie in `S`. +* `ArithmeticTriangleRemovalInVectorSpaces.isolatedTriples V S θ`: the hashed triples sharing no + vector with another hashed triple. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.isMulticoloredSumFree_isolatedTriples`: the isolated + triples form a multicolored sum-free family (Lemma 4.3 of Kleinberg, Sawin and Speyer). +* `ArithmeticTriangleRemovalInVectorSpaces.exists_isMulticoloredSumFree_of_hash`: some hash leaves + at least `#V * #S * (P - F) / P ^ 3` isolated triples, where `F` bounds the number of triples + sharing a vector with a given one (Lemma 4.6 of Kleinberg, Sawin and Speyer). +-/ + +public section + +open Finset Matrix + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {n p P F : ℕ} + +/-- The triples `(a, b, c)` of `A ×ˢ B ×ˢ C` with `a r + b r + c r = p - 1` for every `r`. -/ +def vecSumTriples (p : ℕ) (A B C : Finset (Fin n → ℕ)) : + Finset ((Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ)) := + (A ×ˢ B ×ˢ C).filter fun (a, b, c) ↦ ∀ r, a r + b r + c r = p - 1 + +/-- Two triples share a vector if they agree in some coordinate. -/ +def Shares : + (Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ) → (Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ) → Prop + | (a, b, c), (a', b', c') => a = a' ∨ b = b' ∨ c = c' + +instance : DecidableRel (Shares (n := n)) := + fun (a, b, c) (a', b', c') ↦ inferInstanceAs (Decidable (a = a' ∨ b = b' ∨ c = c')) + +/-- The triples `(a, b, c)` of `V` whose hashes `β + h ⬝ᵥ a` and `α + h ⬝ᵥ c` under `(h, α, β)` +agree and lie in `S`. -/ +private def hashedTriples (V : Finset ((Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ))) + (S : Finset (ZMod P)) : + (Fin n → ZMod P) × ZMod P × ZMod P → Finset ((Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ)) + | (h, α, β) => V.filter fun (a, _, c) ↦ β + h ⬝ᵥ (fun r ↦ (a r : ZMod P)) ∈ S ∧ + α + h ⬝ᵥ (fun r ↦ (c r : ZMod P)) = β + h ⬝ᵥ (fun r ↦ (a r : ZMod P)) + +/-- The hashed triples that share no vector with another hashed triple. -/ +private def isolatedTriples (V : Finset ((Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ))) + (S : Finset (ZMod P)) (θ : (Fin n → ZMod P) × ZMod P × ZMod P) : + Finset ((Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ)) := + {v ∈ hashedTriples V S θ | ∀ v' ∈ hashedTriples V S θ, Shares v v' → v' = v} + +/-- The pairs of distinct triples of `V` sharing a vector. -/ +private def sharingPairs (V : Finset ((Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ))) : + Finset (((Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ)) × + ((Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ))) := + (V ×ˢ V).filter fun (v, v') ↦ v ≠ v' ∧ Shares v v' + +variable {A B C : Finset (Fin n → ℕ)} {V : Finset ((Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ))} + {S : Finset (ZMod P)} {θ : (Fin n → ZMod P) × ZMod P × ZMod P} + {v v' : (Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ)} {a b c a' b' c' : Fin n → ℕ} + +@[simp] +lemma mk_mem_vecSumTriples : + (a, b, c) ∈ vecSumTriples p A B C ↔ a ∈ A ∧ b ∈ B ∧ c ∈ C ∧ ∀ r, a r + b r + c r = p - 1 := by + simp [vecSumTriples, and_assoc] + +lemma card_vecSumTriples_le : #(vecSumTriples p A B C) ≤ #A * #B * #C := by + grw [vecSumTriples, card_filter_le, card_product, card_product, mul_assoc] + +@[simp] +lemma shares_mk : Shares (a, b, c) (a', b', c') ↔ a = a' ∨ b = b' ∨ c = c' := + Iff.rfl + +@[simp] +private lemma mk_mem_hashedTriples {h : Fin n → ZMod P} {α β : ZMod P} : + (a, b, c) ∈ hashedTriples V S (h, α, β) ↔ (a, b, c) ∈ V ∧ + β + h ⬝ᵥ (fun r ↦ (a r : ZMod P)) ∈ S ∧ + α + h ⬝ᵥ (fun r ↦ (c r : ZMod P)) = β + h ⬝ᵥ (fun r ↦ (a r : ZMod P)) := + mem_filter + +private lemma hashedTriples_subset : hashedTriples V S θ ⊆ V := by + obtain ⟨h, α, β⟩ := θ + exact filter_subset _ _ + +private lemma mem_isolatedTriples : + v ∈ isolatedTriples V S θ ↔ + v ∈ hashedTriples V S θ ∧ ∀ v' ∈ hashedTriples V S θ, Shares v v' → v' = v := + mem_filter + +@[simp] +private lemma mk_mem_sharingPairs : + (v, v') ∈ sharingPairs V ↔ (v ∈ V ∧ v' ∈ V) ∧ v ≠ v' ∧ Shares v v' := by + simp [sharingPairs] + +private lemma dotProduct_add_eq_of_add_eq (h : ∀ r, a r + c r = a' r + c' r) (u : Fin n → ZMod P) : + u ⬝ᵥ (fun r ↦ (a r : ZMod P)) + u ⬝ᵥ (fun r ↦ (c r : ZMod P)) = + u ⬝ᵥ (fun r ↦ (a' r : ZMod P)) + u ⬝ᵥ (fun r ↦ (c' r : ZMod P)) := by + rw [← dotProduct_add, ← dotProduct_add] + congr 1 with r + simpa using congr_arg (Nat.cast : ℕ → ZMod P) (h r) + +private lemma eq_of_natCast_eq_natCast (ha : ∀ r, a r < P) (ha' : ∀ r, a' r < P) + (h : (fun r ↦ (a r : ZMod P)) = fun r ↦ (a' r : ZMod P)) : a = a' := by + ext r + have := (ZMod.natCast_eq_natCast_iff' _ _ _).1 (congr_fun h r) + rwa [Nat.mod_eq_of_lt (ha r), Nat.mod_eq_of_lt (ha' r)] at this + +/-- If `∑ r, (a r + b r + c r) = n * (p - 1)`, then `a + b + c + 1` vanishes in `Fin n → ZMod p` if +and only if `a r + b r + c r = p - 1` for every `r`. -/ +private lemma add_add_add_one_eq_zero_iff (hp : 0 < p) + (hsum : ∑ r, (a r + b r + c r) = n * (p - 1)) : + (fun r ↦ (a r : ZMod p)) + (fun r ↦ (b r : ZMod p)) + (fun r ↦ (c r : ZMod p) + 1) = 0 ↔ + ∀ r, a r + b r + c r = p - 1 := by + have hcast (r : Fin n) : + (a r : ZMod p) + b r + (c r + 1) = ((a r + b r + c r + 1 : ℕ) : ZMod p) := by + push_cast + ring + simp only [funext_iff, Pi.add_apply, Pi.zero_apply, hcast, ZMod.natCast_eq_zero_iff] + constructor + · intro h + have hge (r : Fin n) : p - 1 ≤ a r + b r + c r := by grind [Nat.le_of_dvd (by grind) (h r)] + intro r + exact ((sum_eq_sum_iff_of_le fun r _ ↦ hge r).1 (by simp [hsum]) r (mem_univ r)).symm + · intro h r + rw [h r, Nat.sub_add_cancel hp] + +/-- If the hashed triples `(a₁, b₁, c₁)`, `(a₂, b₂, c₂)` and `(a₃, b₃, c₃)` satisfy +`a₁ + c₃ = a₂ + c₂`, then the hashes of `a₁` and `c₃` agree, since `S` has no three-term arithmetic +progressions. -/ +private lemma mk_mem_hashedTriples_of_add_eq_add (hS : ThreeAPFree (S : Set (ZMod P))) + {a₁ b₁ c₁ a₂ b₂ c₂ a₃ b₃ c₃ : Fin n → ℕ} (h₁ : (a₁, b₁, c₁) ∈ hashedTriples V S θ) + (h₂ : (a₂, b₂, c₂) ∈ hashedTriples V S θ) (h₃ : (a₃, b₃, c₃) ∈ hashedTriples V S θ) + (hac : ∀ r, a₁ r + c₃ r = a₂ r + c₂ r) (hV : (a₁, b, c₃) ∈ V) : + (a₁, b, c₃) ∈ hashedTriples V S θ := by + obtain ⟨h, α, β⟩ := θ + simp only [mk_mem_hashedTriples] at h₁ h₂ h₃ ⊢ + obtain ⟨-, hS₁, -⟩ := h₁ + obtain ⟨-, hS₂, hC₂⟩ := h₂ + obtain ⟨-, hS₃, hC₃⟩ := h₃ + have hrel := dotProduct_add_eq_of_add_eq hac h + have hA : β + h ⬝ᵥ (fun r ↦ (a₁ r : ZMod P)) = β + h ⬝ᵥ (fun r ↦ (a₂ r : ZMod P)) := + hS hS₁ hS₂ hS₃ (by linear_combination hrel + hC₂ - hC₃) + exact ⟨hV, hS₁, by linear_combination hrel + hC₂ - 2 * hA⟩ + +/-- **Lemma 4.3 of Kleinberg, Sawin and Speyer.** The isolated triples form a multicolored sum-free +family in `Fin n → ZMod p`, after shifting the third vectors by one. -/ +private lemma isMulticoloredSumFree_isolatedTriples (hp : 0 < p) + (hsum : ∀ a ∈ A, ∀ b ∈ B, ∀ c ∈ C, ∑ r, (a r + b r + c r) = n * (p - 1)) + (hS : ThreeAPFree (S : Set (ZMod P))) (θ : (Fin n → ZMod P) × ZMod P × ZMod P) : + IsMulticoloredSumFree (ι := isolatedTriples (vecSumTriples p A B C) S θ) + (fun ⟨(a, _, _), _⟩ r ↦ (a r : ZMod p)) (fun ⟨(_, b, _), _⟩ r ↦ (b r : ZMod p)) + (fun ⟨(_, _, c), _⟩ r ↦ (c r : ZMod p) + 1) := by + rintro ⟨⟨a₁, b₁, c₁⟩, hi⟩ ⟨⟨a₂, b₂, c₂⟩, hj⟩ ⟨⟨a₃, b₃, c₃⟩, hk⟩ + obtain ⟨hi, hiiso⟩ := mem_isolatedTriples.1 hi + obtain ⟨hj, hjiso⟩ := mem_isolatedTriples.1 hj + obtain ⟨hk, hkiso⟩ := mem_isolatedTriples.1 hk + obtain ⟨ha₁, -, -, hi₀⟩ := mk_mem_vecSumTriples.1 (hashedTriples_subset hi) + obtain ⟨-, hb₂, -, hj₀⟩ := mk_mem_vecSumTriples.1 (hashedTriples_subset hj) + obtain ⟨-, -, hc₃, -⟩ := mk_mem_vecSumTriples.1 (hashedTriples_subset hk) + simp only [Subtype.mk.injEq, Prod.mk.injEq] + rw [add_add_add_one_eq_zero_iff hp (hsum _ ha₁ _ hb₂ _ hc₃)] + constructor + · intro h₀ + have hmem := mk_mem_hashedTriples_of_add_eq_add hS hi hj hk (by grind) + (mk_mem_vecSumTriples.2 ⟨ha₁, hb₂, hc₃, h₀⟩) + grind [hiiso _ hmem, hjiso _ hmem, hkiso _ hmem, shares_mk] + · rintro ⟨⟨rfl, rfl, rfl⟩, rfl, rfl, rfl⟩ + exact hi₀ + +/-- There are `#H * #S` hashes `(h, α, β)` with `h ∈ H` under which `a` and `c` have the same hash +in `S`. -/ +private lemma card_filter_hash [NeZero P] (a c : Fin n → ZMod P) (H : Finset (Fin n → ZMod P)) : + #(univ.filter fun ((h, α, β) : (Fin n → ZMod P) × ZMod P × ZMod P) ↦ + h ∈ H ∧ β + h ⬝ᵥ a ∈ S ∧ α + h ⬝ᵥ c = β + h ⬝ᵥ a) = #H * #S := by + rw [← card_product] + refine card_nbij' (fun (h, _, β) ↦ (h, β + h ⬝ᵥ a)) + (fun (h, s) ↦ (h, s - h ⬝ᵥ c, s - h ⬝ᵥ a)) ?_ ?_ ?_ ?_ + · rintro ⟨h, α, β⟩ + simp +contextual + · rintro ⟨h, s⟩ + simp + · rintro ⟨h, α, β⟩ + simp only [coe_filter, mem_univ, true_and, Set.mem_ofPred_eq, add_sub_cancel_right, + Prod.mk.injEq, and_true, and_imp] + grind + · rintro ⟨h, s⟩ + simp + +/-- A nonzero vector `u` is orthogonal to `P ^ n / P` vectors. -/ +private lemma card_filter_dotProduct_eq_zero_mul [Fact P.Prime] {u : Fin n → ZMod P} (hu : u ≠ 0) : + #{h : Fin n → ZMod P | h ⬝ᵥ u = 0} * P = P ^ n := by + obtain ⟨r, hr⟩ := Function.ne_iff.1 hu + let f : (Fin n → ZMod P) →+ ZMod P := AddMonoidHom.mk' (· ⬝ᵥ u) fun a b ↦ add_dotProduct a b u + have hf : Function.Surjective f := by + intro z + refine ⟨Pi.single r (z / u r), ?_⟩ + simp [f, single_dotProduct, div_mul_cancel₀ z hr] + have := AddSubgroup.card_ker_mul_card_of_surjective (f := f) hf + rw [Nat.card_eq_fintype_card, Nat.card_zmod, Nat.card_eq_fintype_card, Fintype.card_pi] at this + simpa [Fintype.card_subtype, f] using this + +/-- A triple of `V` is hashed by `P ^ n * #S` hashes. -/ +private lemma card_filter_mem_hashedTriples [NeZero P] (hv : v ∈ V) : + #{θ | v ∈ hashedTriples V S θ} = P ^ n * #S := by + obtain ⟨a, b, c⟩ := v + convert card_filter_hash (S := S) (fun r ↦ (a r : ZMod P)) (fun r ↦ (c r : ZMod P)) univ + using 2 + · ext ⟨h, α, β⟩ + simp [hv] + · simp + +/-- A triple of `V` is hashed by `P ^ n * #S / P` hashes `(h, α, β)` with `h ⬝ᵥ u = 0`, for a +nonzero `u`. -/ +private lemma card_filter_mem_hashedTriples_dotProduct_eq_zero_mul [Fact P.Prime] + {u : Fin n → ZMod P} (hu : u ≠ 0) (hv : v ∈ V) : + #(univ.filter fun ((h, α, β) : (Fin n → ZMod P) × ZMod P × ZMod P) ↦ + v ∈ hashedTriples V S (h, α, β) ∧ h ⬝ᵥ u = 0) * P = P ^ n * #S := by + obtain ⟨a, b, c⟩ := v + rw [← card_filter_dotProduct_eq_zero_mul hu, mul_right_comm, + ← card_filter_hash (S := S) (fun r ↦ (a r : ZMod P)) (fun r ↦ (c r : ZMod P))] + congr 2 + ext ⟨h, α, β⟩ + simp only [mem_filter, mem_univ, true_and, mk_mem_hashedTriples] + tauto + +/-- Two distinct triples of `vecSumTriples p A B C` with entries less than `P` differ, after +casting to `ZMod P`, in their first or in their third vector. -/ +private lemma natCast_ne_or_natCast_ne (hpP : p < P) (hv : (a, b, c) ∈ vecSumTriples p A B C) + (hv' : (a', b', c') ∈ vecSumTriples p A B C) (hne : (a, b, c) ≠ (a', b', c')) : + (fun r ↦ (a r : ZMod P)) ≠ (fun r ↦ (a' r : ZMod P)) ∨ + (fun r ↦ (c r : ZMod P)) ≠ (fun r ↦ (c' r : ZMod P)) := by + obtain ⟨-, -, -, hv⟩ := mk_mem_vecSumTriples.1 hv + obtain ⟨-, -, -, hv'⟩ := mk_mem_vecSumTriples.1 hv' + by_contra! h + obtain ⟨ha, hc⟩ := h + obtain rfl := eq_of_natCast_eq_natCast (fun r ↦ by grind [hv r]) (fun r ↦ by grind [hv' r]) ha + obtain rfl := eq_of_natCast_eq_natCast (fun r ↦ by grind [hv r]) (fun r ↦ by grind [hv' r]) hc + apply hne + ext r <;> grind [hv r, hv' r] + +/-- If a hash `(h, α, β)` hashes two triples of `vecSumTriples p A B C` that share a vector, and +`2 ≠ 0` in `ZMod P`, then the hashes `h ⬝ᵥ a` of their first vectors agree, and so do those of their +third vectors. -/ +private lemma dotProduct_eq_and_dotProduct_eq_of_shares [Fact P.Prime] (h2 : (2 : ZMod P) ≠ 0) + {h : Fin n → ZMod P} {α β : ZMod P} + (hv : (a, b, c) ∈ hashedTriples (vecSumTriples p A B C) S (h, α, β)) + (hv' : (a', b', c') ∈ hashedTriples (vecSumTriples p A B C) S (h, α, β)) + (hsh : Shares (a, b, c) (a', b', c')) : + h ⬝ᵥ (fun r ↦ (a r : ZMod P)) = h ⬝ᵥ (fun r ↦ (a' r : ZMod P)) ∧ + h ⬝ᵥ (fun r ↦ (c r : ZMod P)) = h ⬝ᵥ (fun r ↦ (c' r : ZMod P)) := by + simp only [mk_mem_hashedTriples, mk_mem_vecSumTriples] at hv hv' + obtain ⟨⟨-, -, -, hv⟩, -, hC⟩ := hv + obtain ⟨⟨-, -, -, hv'⟩, -, hC'⟩ := hv' + rcases hsh with rfl | rfl | rfl + · exact ⟨rfl, by linear_combination hC - hC'⟩ + · have hrel := dotProduct_add_eq_of_add_eq (fun r ↦ by grind [hv r, hv' r] : + ∀ r, a r + c r = a' r + c' r) h + have ha : h ⬝ᵥ (fun r ↦ (a r : ZMod P)) = h ⬝ᵥ (fun r ↦ (a' r : ZMod P)) := + mul_left_cancel₀ h2 (by linear_combination hrel - hC + hC') + exact ⟨ha, by linear_combination hrel - ha⟩ + · exact ⟨by linear_combination hC' - hC, rfl⟩ + +/-- For two distinct triples of `vecSumTriples p A B C` sharing a vector, there is a nonzero `u` +with `h ⬝ᵥ u = 0` for every hash `(h, α, β)` that hashes both. -/ +private lemma exists_ne_zero_dotProduct_eq_zero [Fact P.Prime] (hp : 2 ≤ p) (hpP : p < P) + (hv : v ∈ vecSumTriples p A B C) (hv' : v' ∈ vecSumTriples p A B C) (hne : v ≠ v') + (hsh : Shares v v') : + ∃ u : Fin n → ZMod P, u ≠ 0 ∧ ∀ (h : Fin n → ZMod P) (α β : ZMod P), + v ∈ hashedTriples (vecSumTriples p A B C) S (h, α, β) → + v' ∈ hashedTriples (vecSumTriples p A B C) S (h, α, β) → h ⬝ᵥ u = 0 := by + obtain ⟨a, b, c⟩ := v + obtain ⟨a', b', c'⟩ := v' + have h2 : (2 : ZMod P) ≠ 0 := by + exact_mod_cast (ZMod.natCast_eq_zero_iff 2 P).not.2 + (Nat.not_dvd_of_pos_of_lt two_pos (by grind)) + rcases natCast_ne_or_natCast_ne hpP hv hv' hne with ha | hc + · refine ⟨_, sub_ne_zero.2 ha, ?_⟩ + intro h α β h₁ h₂ + rw [dotProduct_sub, sub_eq_zero] + exact (dotProduct_eq_and_dotProduct_eq_of_shares h2 h₁ h₂ hsh).1 + · refine ⟨_, sub_ne_zero.2 hc, ?_⟩ + intro h α β h₁ h₂ + rw [dotProduct_sub, sub_eq_zero] + exact (dotProduct_eq_and_dotProduct_eq_of_shares h2 h₁ h₂ hsh).2 + +/-- Two distinct triples of `vecSumTriples p A B C` sharing a vector are both hashed by at most +`P ^ n * #S / P` hashes. -/ +private lemma card_filter_mem_hashedTriples_mul_le [Fact P.Prime] (hp : 2 ≤ p) (hpP : p < P) + (hv : v ∈ vecSumTriples p A B C) (hv' : v' ∈ vecSumTriples p A B C) (hne : v ≠ v') + (hsh : Shares v v') : + #{θ | v ∈ hashedTriples (vecSumTriples p A B C) S θ ∧ + v' ∈ hashedTriples (vecSumTriples p A B C) S θ} * P ≤ P ^ n * #S := by + obtain ⟨u, hu, hθ⟩ := exists_ne_zero_dotProduct_eq_zero (S := S) hp hpP hv hv' hne hsh + rw [← card_filter_mem_hashedTriples_dotProduct_eq_zero_mul hu hv] + apply Nat.mul_le_mul_right + apply card_le_card + rintro ⟨h, α, β⟩ + simp only [mem_filter, mem_univ, true_and] + rintro ⟨h₁, h₂⟩ + exact ⟨h₁, hθ h α β h₁ h₂⟩ + +private lemma sum_card_hashedTriples [NeZero P] : + ∑ θ, #(hashedTriples V S θ) = #V * (P ^ n * #S) := by + have h := sum_card_bipartiteAbove_eq_sum_card_bipartiteBelow (s := univ) (t := V) + (fun θ v ↦ v ∈ hashedTriples V S θ) + simp only [bipartiteAbove, bipartiteBelow, filter_mem_eq_inter, + inter_eq_right.2 hashedTriples_subset] at h + rw [h, sum_const_nat] + intro v hv + exact card_filter_mem_hashedTriples hv + +private lemma card_sharingPairs_le (hF : ∀ v ∈ V, #{v' ∈ V | Shares v v'} ≤ F) : + #(sharingPairs V) ≤ #V * F := by + rw [mul_comm] + refine card_le_mul_card_image_of_maps_to (f := Prod.fst) ?_ F ?_ + · rintro ⟨v, v'⟩ + simp +contextual + intro v hv + grw [← hF v hv] + apply card_le_card_of_injOn Prod.snd + · rintro ⟨_, v'⟩ + simp only [coe_filter, Set.mem_ofPred_eq, mk_mem_sharingPairs] + grind + · rintro ⟨_, _⟩ h₁ ⟨_, _⟩ h₂ + simp only [coe_filter, Set.mem_ofPred_eq] at h₁ h₂ + grind + +private lemma sharingPairs_eq_filter {W : Finset ((Fin n → ℕ) × (Fin n → ℕ) × (Fin n → ℕ))} + (hW : W ⊆ V) : sharingPairs W = (sharingPairs V).filter fun (v, v') ↦ v ∈ W ∧ v' ∈ W := by + ext ⟨v, v'⟩ + simp only [mk_mem_sharingPairs, mem_filter] + grind + +/-- Summed over all hashes, the pairs of distinct hashed triples sharing a vector number at most +`#V * F * P ^ n * #S / P`. -/ +private lemma sum_card_sharingPairs_hashedTriples_mul_le [Fact P.Prime] (hp : 2 ≤ p) (hpP : p < P) + (hF : ∀ v ∈ vecSumTriples p A B C, #{v' ∈ vecSumTriples p A B C | Shares v v'} ≤ F) : + (∑ θ, #(sharingPairs (hashedTriples (vecSumTriples p A B C) S θ))) * P ≤ + #(vecSumTriples p A B C) * F * (P ^ n * #S) := by + simp only [sharingPairs_eq_filter hashedTriples_subset, card_filter] + rw [sum_comm, sum_mul] + grw [sum_le_sum (g := fun _ ↦ P ^ n * #S), sum_const, smul_eq_mul, card_sharingPairs_le hF] + rintro ⟨v, v'⟩ hq + obtain ⟨⟨hv, hv'⟩, hne, hsh⟩ := mk_mem_sharingPairs.1 hq + rw [← card_filter] + exact card_filter_mem_hashedTriples_mul_le hp hpP hv hv' hne hsh + +/-- A hashed triple is isolated unless it is the first member of a pair of hashed triples sharing +a vector. -/ +private lemma card_hashedTriples_le (θ : (Fin n → ZMod P) × ZMod P × ZMod P) : + #(hashedTriples V S θ) ≤ + #(isolatedTriples V S θ) + #(sharingPairs (hashedTriples V S θ)) := by + grw [← card_image_le (s := sharingPairs (hashedTriples V S θ)) (f := Prod.fst), ← card_union_le] + apply card_le_card + intro v hv + by_cases hiso : v ∈ isolatedTriples V S θ + · exact mem_union_left _ hiso + simp only [mem_isolatedTriples, hv, true_and, not_forall] at hiso + obtain ⟨v', hv', hsh, hne⟩ := hiso + exact mem_union_right _ (mem_image.2 ⟨(v, v'), by simp [hv, hv', Ne.symm hne, hsh], rfl⟩) + +/-- Summed over all hashes, the isolated triples number at least +`#V * P ^ n * #S * (P - F) / P`. -/ +private lemma mul_le_mul_sum_card_isolatedTriples_add [Fact P.Prime] (hp : 2 ≤ p) (hpP : p < P) + (hF : ∀ v ∈ vecSumTriples p A B C, #{v' ∈ vecSumTriples p A B C | Shares v v'} ≤ F) : + #(vecSumTriples p A B C) * (P ^ n * #S) * P ≤ + P * ∑ θ, #(isolatedTriples (vecSumTriples p A B C) S θ) + + #(vecSumTriples p A B C) * F * (P ^ n * #S) := by + have h : ∑ θ, #(hashedTriples (vecSumTriples p A B C) S θ) ≤ + ∑ θ, (#(isolatedTriples (vecSumTriples p A B C) S θ) + + #(sharingPairs (hashedTriples (vecSumTriples p A B C) S θ))) := by + apply sum_le_sum + intro θ _ + exact card_hashedTriples_le θ + rw [sum_card_hashedTriples, sum_add_distrib] at h + nlinarith [sum_card_sharingPairs_hashedTriples_mul_le (S := S) hp hpP hF] + +/-- **Lemma 4.6 of Kleinberg, Sawin and Speyer.** Some hash leaves at least +`#V * #S * (P - F) / P ^ 3` isolated triples, which form a multicolored sum-free family. -/ +lemma exists_isMulticoloredSumFree_of_hash [Fact P.Prime] (hp : 2 ≤ p) (hpP : p < P) + (hsum : ∀ a ∈ A, ∀ b ∈ B, ∀ c ∈ C, ∑ r, (a r + b r + c r) = n * (p - 1)) + (hF : ∀ v ∈ vecSumTriples p A B C, #{v' ∈ vecSumTriples p A B C | Shares v v'} ≤ F) + (hS : ThreeAPFree (S : Set (ZMod P))) : + ∃ (m : ℕ) (x y z : Fin m → Fin n → ZMod p), IsMulticoloredSumFree x y z ∧ + #(vecSumTriples p A B C) * #S * (P - F : ℝ) ≤ m * P ^ 3 := by + have hP : (0 : ℝ) < P := by exact_mod_cast (Fact.out : P.Prime).pos + have h : (#(vecSumTriples p A B C) * (P ^ n * #S) * P : ℝ) ≤ + P * ∑ θ, (#(isolatedTriples (vecSumTriples p A B C) S θ) : ℝ) + + #(vecSumTriples p A B C) * F * (P ^ n * #S) := by + exact_mod_cast mul_le_mul_sum_card_isolatedTriples_add hp hpP hF + have havg : ∑ _θ : (Fin n → ZMod P) × ZMod P × ZMod P, + #(vecSumTriples p A B C) * #S * (P - F : ℝ) / P ^ 3 ≤ + ∑ θ, (#(isolatedTriples (vecSumTriples p A B C) S θ) : ℝ) := by + simp only [sum_const, card_univ, Fintype.card_prod, Fintype.card_pi, ZMod.card, prod_const, + Fintype.card_fin, nsmul_eq_mul] + rw [← mul_div_assoc, div_le_iff₀ (by positivity)] + push_cast + nlinarith [mul_le_mul_of_nonneg_left h (by positivity : (0 : ℝ) ≤ P ^ 2)] + obtain ⟨θ, -, hθ⟩ := exists_le_of_sum_le univ_nonempty havg + rw [div_le_iff₀ (by positivity)] at hθ + exact ⟨_, _, _, _, (isMulticoloredSumFree_isolatedTriples (by grind) hsum hS θ).comp + (isolatedTriples _ S θ).equivFin.symm.injective, hθ⟩ + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/LowerBound.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/LowerBound.lean new file mode 100644 index 0000000000..021f58e123 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/LowerBound.lean @@ -0,0 +1,434 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Basic +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Exponent +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Construction.Family +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Coupling.Decreasing +import Mathlib.Algebra.BigOperators.Field +import Mathlib.Algebra.Order.Ring.GeomSum + +/-! +# Large multicolored sum-free families + +Kleinberg, Sawin and Speyer showed that the exponent `1 - c p` in the bound on multicolored +sum-free families in `Fin n → ZMod p` cannot be lowered. Pebody's theorem gives a coupling `J` of +three copies of the truncated geometric distribution `geomDist N ρ` on `range (N + 1)`, with +`N = p - 1`, of mean `N / 3`. Rounding `d * J` down gives a base point whose coordinates have +empirical distributions within a bounded error of `d * geomDist N ρ`, so their type classes have +about `(ρ ^ (-N / 3) * ∑ k, ρ ^ k) ^ n ≥ p ^ ((1 - c p) * n)` elements. The sum-free family of +this base point, padded with zero coordinates, has at least `p ^ ((1 - c p - η) * n)` members for +`n ≥ n₀ p η`. Taking `ρ ≥ 1 / 2` bounds the error terms by explicit functions of `p`. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.geomDist N ρ`: the truncated geometric distribution + `k ↦ ρ ^ k / ∑ j ∈ range (N + 1), ρ ^ j`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.exists_card_filter_mem_Icc`: rounding a coupling to a + base point. +* `ArithmeticTriangleRemovalInVectorSpaces.le_log_card_typeClass_geomDist`: the size of a type + class whose empirical distribution is close to a multiple of `geomDist N ρ`. +* `ArithmeticTriangleRemovalInVectorSpaces.exists_le_log_card_typeClass`: base points with large + type classes in every dimension `d ≥ p ^ 4 + 1`. +* `ArithmeticTriangleRemovalInVectorSpaces.exists_isMulticoloredSumFree_rpow_le`: for every + `η > 0` and `n ≥ n₀ p η`, there is a multicolored sum-free family in `Fin n → ZMod p` with at + least `p ^ ((1 - c p - η) * n)` members (the second part of Theorem 2 of Fox and Lovász). +-/ + +public section + +open Finset Real + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {n N : ℕ} {ρ : ℝ} + +/-- The truncated geometric distribution `k ↦ ρ ^ k / ∑ j ∈ range (N + 1), ρ ^ j` on +`range (N + 1)`. -/ +private noncomputable def geomDist (N : ℕ) (ρ : ℝ) (k : ℕ) : ℝ := + ρ ^ k / ∑ j ∈ range (N + 1), ρ ^ j + +private lemma geomDist_pos (hρ : 0 < ρ) (k : ℕ) : 0 < geomDist N ρ k := + div_pos (pow_pos hρ k) (geom_sum_pos hρ.le N.succ_ne_zero) + +private lemma sum_geomDist (hρ : 0 < ρ) : ∑ k ∈ range (N + 1), geomDist N ρ k = 1 := by + simp only [geomDist] + rw [← sum_div, div_self (geom_sum_pos hρ.le N.succ_ne_zero).ne'] + +private lemma geomDist_le_one (hρ : 0 < ρ) {k : ℕ} (hk : k ≤ N) : geomDist N ρ k ≤ 1 := by + rw [geomDist, div_le_one (geom_sum_pos hρ.le N.succ_ne_zero)] + exact single_le_sum (fun j _ ↦ by positivity) (mem_range_succ_iff.2 hk) + +private lemma geomDist_le_geomDist (hρ₀ : 0 < ρ) (hρ₁ : ρ < 1) {k : ℕ} (hk : k ≤ N) : + geomDist N ρ N ≤ geomDist N ρ k := by + rw [geomDist, geomDist, div_le_div_iff_of_pos_right (geom_sum_pos hρ₀.le N.succ_ne_zero)] + exact pow_le_pow_of_le_one hρ₀.le hρ₁.le hk + +private lemma log_inv_geomDist (hρ : 0 < ρ) (k : ℕ) : + log (geomDist N ρ k)⁻¹ = log (∑ j ∈ range (N + 1), ρ ^ j) - k * log ρ := by + rw [geomDist, inv_div, log_div (geom_sum_pos hρ.le N.succ_ne_zero).ne' (by positivity), + log_pow] + +/-- `geomDist N ρ` has mean `N / 3` if `3 * ∑ k, k * ρ ^ k = N * ∑ k, ρ ^ k`. -/ +private lemma sum_mul_geomDist (hρ : 0 < ρ) + (hmean : 3 * ∑ k ∈ range (N + 1), k * ρ ^ k = N * ∑ k ∈ range (N + 1), ρ ^ k) : + ∑ k ∈ range (N + 1), k * geomDist N ρ k = N / 3 := by + simp only [geomDist, mul_div_assoc', ← sum_div] + rw [div_eq_div_iff (geom_sum_pos hρ.le N.succ_ne_zero).ne' three_ne_zero] + linarith + +/-- If each value `k ≤ N` appears in `a` between `t * μ k - T` and `t * μ k` times, then `n` lies +between `t * ∑ k, μ k - (N + 1) * T` and `t * ∑ k, μ k`. -/ +private lemma natCast_mem_Icc_of_card_filter_mem_Icc {a : Fin n → ℕ} (ha : ∀ r, a r ≤ N) {μ : ℕ → ℝ} + {t T : ℝ} + (hD : ∀ k ∈ range (N + 1), (#{r | a r = k} : ℝ) ∈ Set.Icc (t * μ k - T) (t * μ k)) : + (n : ℝ) ∈ + Set.Icc (t * ∑ k ∈ range (N + 1), μ k - (N + 1) * T) (t * ∑ k ∈ range (N + 1), μ k) := by + rw [← sum_card_filter_eq ha, mul_sum] + push_cast + constructor + · have h : ∑ k ∈ range (N + 1), (t * μ k - T) ≤ ∑ k ∈ range (N + 1), (#{r | a r = k} : ℝ) := by + apply sum_le_sum + intro k hk + obtain ⟨h, -⟩ := hD k hk + exact h + rw [sum_sub_distrib, sum_const, card_range, nsmul_eq_mul] at h + push_cast at h + linarith + · apply sum_le_sum + intro k hk + obtain ⟨-, h⟩ := hD k hk + exact h + +private lemma sum_card_filter_mul_log_inv_geomDist {a : Fin n → ℕ} (ha : ∀ r, a r ≤ N) + (hρ : 0 < ρ) : + ∑ k ∈ range (N + 1), #{r | a r = k} * log (geomDist N ρ k)⁻¹ = + n * log (∑ k ∈ range (N + 1), ρ ^ k) - + (∑ k ∈ range (N + 1), (k : ℝ) * #{r | a r = k}) * log ρ := by + simp only [log_inv_geomDist hρ, mul_sub, sum_sub_distrib, ← sum_mul, + (by exact_mod_cast sum_card_filter_eq ha : ∑ k ∈ range (N + 1), (#{r | a r = k} : ℝ) = n)] + congr 1 + rw [sum_mul] + congr with k + ring + +/-- **The empirical mean.** If `geomDist N ρ` has mean `N / 3`, each value `k ≤ N` appears in `a` +at least `t * geomDist N ρ k - T` times and `n ≤ t`, then the entries of `a` sum to at least +`n * N / 3 - T * N * (N + 1)`. -/ +private lemma mul_div_sub_le_sum_mul_card_filter {a : Fin n → ℕ} (hρ : 0 < ρ) + (hmean : 3 * ∑ k ∈ range (N + 1), k * ρ ^ k = N * ∑ k ∈ range (N + 1), ρ ^ k) {t T : ℝ} + (hT : 0 ≤ T) (hD : ∀ k ∈ range (N + 1), t * geomDist N ρ k - T ≤ #{r | a r = k}) + (hnt : n ≤ t) : + n * N / 3 - T * N * (N + 1) ≤ ∑ k ∈ range (N + 1), (k : ℝ) * #{r | a r = k} := by + have h₁ : ∑ k ∈ range (N + 1), (k : ℝ) * (t * geomDist N ρ k - T) ≤ + ∑ k ∈ range (N + 1), (k : ℝ) * #{r | a r = k} := by + gcongr with k hk + exact hD k hk + have h₂ : ∑ k ∈ range (N + 1), (k : ℝ) ≤ N * (N + 1) := by + grw [sum_le_card_nsmul (range (N + 1)) (fun k : ℕ ↦ (k : ℝ)) N (by simp)] + simp [mul_comm] + simp only [mul_sub, sum_sub_distrib, mul_left_comm _ t, ← mul_sum, ← sum_mul, + sum_mul_geomDist hρ hmean] at h₁ + linarith [mul_le_mul_of_nonneg_right h₂ hT, mul_le_mul_of_nonneg_right hnt N.cast_nonneg] + +/-- If `D ∈ [t * ψ - T, t * ψ]` and `n ∈ [t - S, t]` with `0 ≤ T ≤ S`, `1 ≤ n` and +`0 < y ≤ ψ ≤ 1`, then `(D - n * ψ) ^ 2 / (n * ψ) ≤ S ^ 2 / y`. -/ +private lemma sq_sub_mul_div_mul_le {D n t S T ψ y : ℝ} (hy : 0 < y) (hyψ : y ≤ ψ) (hψ : ψ ≤ 1) + (hn : 1 ≤ n) (hT : 0 ≤ T) (hTS : T ≤ S) (hD : D ∈ Set.Icc (t * ψ - T) (t * ψ)) + (hnt : n ∈ Set.Icc (t - S) t) : + (D - n * ψ) ^ 2 / (n * ψ) ≤ S ^ 2 / y := by + obtain ⟨hD₁, hD₂⟩ := hD + obtain ⟨hn₁, hn₂⟩ := hnt + gcongr ?_ / ?_ + · exact sq_le_sq' (by nlinarith) (by nlinarith) + · nlinarith + +/-- **Type classes near the geometric distribution.** If `ρ ∈ (0, 1)`, `geomDist N ρ` has mean +`N / 3` and each value `k ≤ N` appears in `a` between `t * geomDist N ρ k - T` and +`t * geomDist N ρ k` times, then `log #(typeClass a)` is at least +`n * (log (∑ k, ρ ^ k) - N / 3 * log ρ)` minus an error of order `log n`. -/ +private lemma le_log_card_typeClass_geomDist (hρ₀ : 0 < ρ) (hρ₁ : ρ < 1) + (hmean : 3 * ∑ k ∈ range (N + 1), k * ρ ^ k = N * ∑ k ∈ range (N + 1), ρ ^ k) {T t : ℝ} + (hT : 0 ≤ T) (a : Fin n → ℕ) (ha : ∀ r, a r ≤ N) (hn : 1 ≤ n) + (hD : ∀ k ∈ range (N + 1), + (#{r | a r = k} : ℝ) ∈ Set.Icc (t * geomDist N ρ k - T) (t * geomDist N ρ k)) : + n * (log (∑ k ∈ range (N + 1), ρ ^ k) - N / 3 * log ρ) - + ((N + 1) * (1 + ((N + 1) * T) ^ 2 / geomDist N ρ N) - T * N * (N + 1) * log ρ) - + (N + 1) * log (n + 1) ≤ log #(typeClass a) := by + have hnt := natCast_mem_Icc_of_card_filter_mem_Icc ha hD + rw [sum_geomDist hρ₀, mul_one] at hnt + have hquad (k : ℕ) (hk : k ∈ range (N + 1)) : + (#{r | a r = k} - n * geomDist N ρ k) ^ 2 / (n * geomDist N ρ k) ≤ + ((N + 1) * T) ^ 2 / geomDist N ρ N := + sq_sub_mul_div_mul_le (geomDist_pos hρ₀ N) + (geomDist_le_geomDist hρ₀ hρ₁ (mem_range_succ_iff.1 hk)) + (geomDist_le_one hρ₀ (mem_range_succ_iff.1 hk)) (by exact_mod_cast hn) hT + (le_mul_of_one_le_left hT (by simp)) (hD k hk) hnt + have key := le_log_card_typeClass a ha (fun k _ ↦ geomDist_pos hρ₀ k) (sum_geomDist hρ₀) + rw [sum_card_filter_mul_log_inv_geomDist ha hρ₀] at key + grw [sum_le_sum hquad] at key + obtain ⟨-, hnt⟩ := hnt + simp only [sum_const, card_range, nsmul_eq_mul, Nat.cast_add_one] at key + nlinarith [mul_le_mul_of_nonpos_right (mul_div_sub_le_sum_mul_card_filter hρ₀ hmean hT + (fun k hk ↦ (hD k hk).1) hnt) (log_neg hρ₀ hρ₁).le] + +/-- `(1 - c (N + 1)) * log (N + 1) ≤ log (∑ k, ρ ^ k) - N / 3 * log ρ` for `ρ ∈ (0, 1)`, by the +definition of `c`. -/ +private lemma one_sub_c_mul_log_le (hN : 0 < N) (hρ₀ : 0 < ρ) (hρ₁ : ρ < 1) : + (1 - c (N + 1)) * log (N + 1) ≤ log (∑ k ∈ range (N + 1), ρ ^ k) - N / 3 * log ρ := by + have h := log_le_log (by positivity) (rpow_one_sub_c_le (p := N + 1) (by grind) hρ₀ hρ₁) + rw [log_rpow (by positivity), + log_mul (by positivity) (geom_sum_pos hρ₀.le (by simp : N + 1 ≠ 0)).ne', log_rpow hρ₀] at h + push_cast at h + linarith + +/-- Listing every `x ∈ s` exactly `C x` times gives a sequence `f` with values in `s` taking the +value `k` under `g` exactly `∑ x ∈ s with g x = k, C x` times. -/ +private lemma exists_card_filter_eq_sum {α β : Type*} [DecidableEq β] (s : Finset α) (C : α → ℕ) : + ∃ (n : ℕ) (f : Fin n → α), (∀ r, f r ∈ s) ∧ + ∀ (g : α → β) (k : β), #{r | g (f r) = k} = ∑ x ∈ s with g x = k, C x := by + classical + let e := Fintype.equivFin (Σ x : s, Fin (C x)) + refine ⟨_, fun r ↦ (e.symm r).fst, fun r ↦ (e.symm r).fst.prop, ?_⟩ + intro g k + rw [card_equiv e.symm (t := {x | g x.fst = k}) (by simp), card_filter, Fintype.sum_sigma, + sum_filter, ← sum_coe_sort s] + simp [apply_ite card] + +/-- **Rounding a coupling.** Rounding `t * J` down on the triples with sum `N` gives a sequence +`f₀` of such triples in which, for every `g`, the value `k` of `g` appears between +`t * marginal N J g k - #(sumTriples N)` and `t * marginal N J g k` times. -/ +private lemma exists_card_filter_mem_Icc {J : ℕ × ℕ × ℕ → ℝ} (hJ : ∀ x, 0 ≤ J x) {t : ℝ} + (ht : 0 ≤ t) : ∃ (n : ℕ) (f₀ : Fin n → ℕ × ℕ × ℕ), (∀ r, f₀ r ∈ sumTriples N) ∧ + ∀ (g : ℕ × ℕ × ℕ → ℕ) (k : ℕ), (#{r | g (f₀ r) = k} : ℝ) ∈ + Set.Icc (t * marginal N J g k - #(sumTriples N)) (t * marginal N J g k) := by + obtain ⟨n, f₀, hf₀, hcard⟩ := + exists_card_filter_eq_sum (β := ℕ) (sumTriples N) fun x ↦ ⌊t * J x⌋₊ + refine ⟨n, f₀, hf₀, ?_⟩ + intro g k + rw [hcard, marginal, mul_sum] + push_cast + constructor + · have h : ∑ x ∈ sumTriples N with g x = k, (t * J x - 1) ≤ + ∑ x ∈ sumTriples N with g x = k, (⌊t * J x⌋₊ : ℝ) := by + apply sum_le_sum + intro x _ + exact (Nat.sub_one_lt_floor _).le + rw [sum_sub_distrib, sum_const, nsmul_one] at h + linarith [(Nat.cast_le (α := ℝ)).2 (card_filter_le (sumTriples N) fun x ↦ g x = k)] + · apply sum_le_sum + intro x _ + exact Nat.floor_le (mul_nonneg ht (hJ x)) + +private lemma marginal_inv_smul_eq_geomDist {J : ℕ × ℕ × ℕ → ℝ} {g : ℕ × ℕ × ℕ → ℕ} + (hg : marginal N J g = geom N ρ) {k : ℕ} (hk : k ≤ N) : + marginal N ((∑ j ∈ range (N + 1), ρ ^ j)⁻¹ • J) g k = geomDist N ρ k := by + simp [marginal_smul, hg, geom, geomDist, hk, div_eq_inv_mul] + +private lemma card_sumTriples_le (N : ℕ) : #(sumTriples N) ≤ (N + 1) ^ 3 := by + grw [card_le_card (t := range (N + 1) ×ˢ range (N + 1) ×ˢ range (N + 1)) ?_] + · simp [pow_three] + · rintro ⟨a, b, c⟩ h + grind [mem_sumTriples] + +/-- For `ρ ∈ [1 / 2, 1]`, `(geomDist N ρ N)⁻¹ ≤ (N + 1) * 2 ^ N`. -/ +private lemma inv_geomDist_le (hρ₀ : 1 / 2 ≤ ρ) (hρ₁ : ρ ≤ 1) : + (geomDist N ρ N)⁻¹ ≤ (N + 1) * 2 ^ N := by + rw [geomDist, inv_div, div_le_iff₀ (pow_pos (by linarith) N), mul_assoc, ← mul_pow] + grw [sum_le_card_nsmul _ _ 1 fun j _ ↦ pow_le_one₀ (by linarith) hρ₁] + simp only [card_range, nsmul_one, Nat.cast_add_one] + exact le_mul_of_one_le_right (by positivity) (one_le_pow₀ (by linarith)) + +/-- For `N > 0`, `0 ≤ T ≤ (N + 1) ^ 3` and `ρ ∈ [1 / 2, 1)`, the error term of +`le_log_card_typeClass_geomDist` is at most `2 ^ (N + 1) * (N + 1) ^ 10`. -/ +private lemma mul_one_add_sq_div_geomDist_sub_le (hN : 0 < N) (hρ₀ : 1 / 2 ≤ ρ) (hρ₁ : ρ < 1) + {T : ℝ} (hT₀ : 0 ≤ T) (hT : T ≤ (N + 1) ^ 3) : + (N + 1) * (1 + ((N + 1) * T) ^ 2 / geomDist N ρ N) - T * N * (N + 1) * log ρ ≤ + 2 ^ (N + 1) * (N + 1) ^ 10 := by + have hsq : ((N + 1) * T) ^ 2 / geomDist N ρ N ≤ + ((N + 1) * (N + 1) ^ 3) ^ 2 * ((N + 1) * 2 ^ N) := by + rw [div_eq_mul_inv] + gcongr + · exact (inv_pos.2 (geomDist_pos (by linarith) N)).le + · exact inv_geomDist_le hρ₀ hρ₁.le + have hlog : T * N * (N + 1) * -log ρ ≤ (N + 1) ^ 3 * (N + 1) * (N + 1) * 1 := by + gcongr + · linarith [log_neg (by linarith : 0 < ρ) hρ₁] + · linarith + · linarith [one_sub_inv_le_log_of_pos (by linarith : 0 < ρ), + (inv_le_comm₀ (by linarith : 0 < ρ) two_pos).2 (by linarith)] + have hq : (N + 1 : ℝ) + (N + 1) ^ 5 ≤ 2 ^ N * (N + 1) ^ 10 := by + have h₂ : (2 : ℝ) ≤ N + 1 := by norm_cast; grind + grw [← one_le_pow₀ (by norm_num : (1 : ℝ) ≤ 2) (n := N), one_mul] + nlinarith [le_self_pow₀ (by linarith : (1 : ℝ) ≤ N + 1) (by norm_num : 5 ≠ 0), + mul_le_mul_of_nonneg_right (pow_le_pow_left₀ (by norm_num) h₂ 5) + (by positivity : (0 : ℝ) ≤ (N + 1) ^ 5)] + rw [pow_succ (2 : ℝ) N] + nlinarith [mul_le_mul_of_nonneg_left hsq (by positivity : (0 : ℝ) ≤ N + 1)] + +/-- **Base points with large type classes.** For `p ≥ 2` and `d ≥ p ^ 4 + 1` there are +`n ∈ [d - p ^ 4, d]` and `a₀ b₀ c₀ : Fin n → ℕ` with `a₀ r + b₀ r + c₀ r = p - 1` whose type +classes all have at least `exp (n * ((1 - c p) * log p) - 2 ^ p * p ^ 10 - p * log (n + 1))` +elements. -/ +private lemma exists_le_log_card_typeClass {p d : ℕ} (hp : 2 ≤ p) (hd : p ^ 4 + 1 ≤ d) : + ∃ (n : ℕ) (a₀ b₀ c₀ : Fin n → ℕ), + (∀ r, a₀ r + b₀ r + c₀ r = p - 1) ∧ d - (p : ℝ) ^ 4 ≤ n ∧ n ≤ d ∧ + n * ((1 - c p) * log p) - 2 ^ p * p ^ 10 - p * log (n + 1) ≤ log #(typeClass a₀) ∧ + n * ((1 - c p) * log p) - 2 ^ p * p ^ 10 - p * log (n + 1) ≤ log #(typeClass b₀) ∧ + n * ((1 - c p) * log p) - 2 ^ p * p ^ 10 - p * log (n + 1) ≤ log #(typeClass c₀) := by + obtain ⟨N, rfl⟩ : ∃ N, p = N + 1 := ⟨p - 1, by grind⟩ + obtain ⟨ρ, hρ, hρ₁, hmean, J, hJ, h₁, h₂, h₃⟩ := exists_compatible_geom (N := N) (by grind) + have hρ₀ : 0 < ρ := by linarith + have hS : (#(sumTriples N) : ℝ) ≤ (N + 1) ^ 3 := by exact_mod_cast card_sumTriples_le N + have hd' : ((N + 1) ^ 4 + 1 : ℝ) ≤ d := by exact_mod_cast hd + obtain ⟨n, f₀, hf₀, hcount⟩ := exists_card_filter_mem_Icc (N := N) + (J := (∑ j ∈ range (N + 1), ρ ^ j)⁻¹ • J) + (fun x ↦ mul_nonneg (inv_pos.2 (geom_sum_pos hρ₀.le N.succ_ne_zero)).le (hJ x)) + d.cast_nonneg + have hD (g : ℕ × ℕ × ℕ → ℕ) (hg : marginal N J g = geom N ρ) (k : ℕ) + (hk : k ∈ range (N + 1)) : (#{r | g (f₀ r) = k} : ℝ) ∈ + Set.Icc (d * geomDist N ρ k - #(sumTriples N)) (d * geomDist N ρ k) := by + rw [← marginal_inv_smul_eq_geomDist hg (mem_range_succ_iff.1 hk)] + exact hcount g k + obtain ⟨a₀, b₀, c₀, rfl⟩ : ∃ a₀ b₀ c₀ : Fin n → ℕ, f₀ = fun r ↦ (a₀ r, b₀ r, c₀ r) := + ⟨_, _, _, rfl⟩ + have hsum (r : Fin n) : a₀ r + b₀ r + c₀ r = N := mem_sumTriples.1 (hf₀ r) + obtain ⟨hn₁, hn₂⟩ := natCast_mem_Icc_of_card_filter_mem_Icc (fun r ↦ by grind [hsum r]) + (hD _ h₁) + rw [sum_geomDist hρ₀, mul_one] at hn₁ hn₂ + have hn : (d : ℝ) - (N + 1) ^ 4 ≤ n := by + linarith [mul_le_mul_of_nonneg_left hS (by positivity : (0 : ℝ) ≤ N + 1)] + have hlog (g : ℕ × ℕ × ℕ → ℕ) (hga : ∀ r, g (a₀ r, b₀ r, c₀ r) ≤ N) + (hg : marginal N J g = geom N ρ) : + n * ((1 - c (N + 1)) * log (N + 1 : ℕ)) - 2 ^ (N + 1) * (N + 1 : ℕ) ^ 10 - + (N + 1 : ℕ) * log (n + 1) ≤ log #(typeClass fun r ↦ g (a₀ r, b₀ r, c₀ r)) := by + push_cast + nlinarith [le_log_card_typeClass_geomDist hρ₀ hρ₁ hmean (Nat.cast_nonneg _) _ hga + (by exact_mod_cast (by linarith : (1 : ℝ) ≤ n)) (hD g hg), + mul_le_mul_of_nonneg_left (one_sub_c_mul_log_le (N := N) (by grind) hρ₀ hρ₁) n.cast_nonneg, + mul_one_add_sq_div_geomDist_sub_le (by grind) hρ hρ₁ (by positivity) hS] + exact ⟨n, a₀, b₀, c₀, fun r ↦ by grind [hsum r], by push_cast; linarith, + by exact_mod_cast hn₂, hlog (fun (a, _, _) ↦ a) (fun r ↦ by grind [hsum r]) h₁, + hlog (fun (_, b, _) ↦ b) (fun r ↦ by grind [hsum r]) h₂, + hlog (fun (_, _, c) ↦ c) (fun r ↦ by grind [hsum r]) h₃⟩ + +/-- Extending the vectors of a multicolored sum-free family by zero coordinates keeps it +multicolored sum-free. -/ +private lemma IsMulticoloredSumFree.extend {ι G : Type*} [AddCommGroup G] {x y z : ι → Fin n → G} + (h : IsMulticoloredSumFree x y z) {d : ℕ} (hnd : n ≤ d) : + IsMulticoloredSumFree (fun i ↦ Function.extend (Fin.castLE hnd) (x i) 0) + (fun i ↦ Function.extend (Fin.castLE hnd) (y i) 0) + fun i ↦ Function.extend (Fin.castLE hnd) (z i) 0 := + h.map (Function.ExtendByZero.hom G (Fin.castLE hnd)) + (Function.extend_injective (Fin.castLE_injective hnd) 0) + +/-- **A family in every large dimension.** For `p ≥ 2` and `d ≥ p ^ 4 + 1` there are +`n ∈ [d - p ^ 4, d]` and a multicolored sum-free family in `Fin d → ZMod p` with at least +`exp (n * ((1 - c p) * log p) - 2 ^ p * p ^ 10 - p * log (n + 1) - +4 * √(log ((12 + 2 * p) * p ^ (3 * n)))) / (4 * (12 + 2 * p))` members. -/ +private lemma exists_isMulticoloredSumFree_exp_le {p d : ℕ} (hp : 2 ≤ p) (hd : p ^ 4 + 1 ≤ d) : + ∃ (n m : ℕ) (x y z : Fin m → Fin d → ZMod p), + IsMulticoloredSumFree x y z ∧ d - (p : ℝ) ^ 4 ≤ n ∧ n ≤ d ∧ + exp (n * ((1 - c p) * log p) - 2 ^ p * p ^ 10 - p * log (n + 1) - + 4 * √(log ((12 + 2 * p) * p ^ (3 * n)))) / (4 * (12 + 2 * p)) ≤ m := by + obtain ⟨n, a₀, b₀, c₀, h₀, hn₁, hn₂, ha, hb, hc⟩ := exists_le_log_card_typeClass hp hd + have hw (a : Fin n → ℕ) (h : n * ((1 - c p) * log p) - 2 ^ p * p ^ 10 - p * log (n + 1) ≤ + log #(typeClass a)) : + max 1 (exp (n * ((1 - c p) * log p) - 2 ^ p * p ^ 10 - p * log (n + 1))) ≤ + #(typeClass a) := + max_le (Nat.one_le_cast.2 (typeClass_nonempty a).card_pos) + ((le_log_iff_exp_le (Nat.cast_pos.2 (typeClass_nonempty a).card_pos)).1 h) + obtain ⟨m, x, y, z, hsf, hm⟩ := exists_isMulticoloredSumFree_of_typeClass hp h₀ + (le_max_left _ _) (hw _ ha) (hw _ hb) (hw _ hc) + have hnd : n ≤ d := by exact_mod_cast hn₂ + refine ⟨n, m, _, _, _, hsf.extend hnd, hn₁, hn₂, ?_⟩ + grw [← hm] + rw [div_le_div_iff_of_pos_right (by positivity), sub_eq_add_neg _ (4 * √_), exp_add, ← neg_mul] + exact mul_le_mul_of_nonneg_right (le_max_right _ _) (exp_pos _).le + +/-- For `a > 0`, `b * √(d + 1) ≤ a * d` once `2 * b / a ≤ B` and `B ^ 2 + 1 ≤ d`. -/ +private lemma mul_sqrt_add_one_le {a b B : ℝ} (ha : 0 < a) (hb : 2 * b / a ≤ B) {d : ℕ} + (hd : B ^ 2 + 1 ≤ d) : b * √(d + 1) ≤ a * d := by + grw [(le_abs_self B).trans (abs_le_sqrt (by linarith : B ^ 2 ≤ d + 1)), div_le_iff₀ ha] at hb + nlinarith [sq_sqrt (by positivity : (0 : ℝ) ≤ d + 1), sqrt_nonneg (d + 1)] + +/-- The error terms of `exists_isMulticoloredSumFree_exp_le` are at most `ε * d` for large `d`: +for `0 ≤ A` and `ε > 0`, `A + p * log (n + 1) + 4 * √(log ((12 + 2 * p) * p ^ (3 * n))) ≤ ε * d` +for every `n ≤ d` once `2 * b / ε ≤ B` and `B ^ 2 + 1 ≤ d`, where +`b = A + 2 * p + 4 * √(log (12 + 2 * p) + 3 * log p)`. -/ +private lemma add_mul_log_add_sqrt_le {p : ℕ} (hp : 2 ≤ p) {A ε B : ℝ} (hA : 0 ≤ A) (hε : 0 < ε) + (hb : 2 * (A + 2 * p + 4 * √(log (12 + 2 * p) + 3 * log p)) / ε ≤ B) {d : ℕ} + (hd : B ^ 2 + 1 ≤ d) {n : ℕ} (hn : n ≤ d) : + A + p * log (n + 1) + 4 * √(log ((12 + 2 * p) * p ^ (3 * n))) ≤ ε * d := by + have hn' : (n : ℝ) ≤ d := by exact_mod_cast hn + have hlog : log (n + 1) ≤ 2 * √(d + 1) := by + grw [log_le_log (by positivity) (by linarith : (n : ℝ) + 1 ≤ d + 1), + log_le_rpow_div (by positivity) (by norm_num : (0 : ℝ) < 1 / 2), ← sqrt_eq_rpow] + linarith + have hsq : √(log ((12 + 2 * p) * p ^ (3 * n))) ≤ + √(log (12 + 2 * p) + 3 * log p) * √(d + 1) := by + rw [← sqrt_mul' _ (by positivity)] + apply sqrt_le_sqrt + rw [log_mul (by positivity) (by positivity), log_pow] + push_cast + nlinarith [log_nonneg (by linarith [p.cast_nonneg (α := ℝ)] : (1 : ℝ) ≤ 12 + 2 * p), + log_nonneg (by exact_mod_cast (by grind : 1 ≤ p) : (1 : ℝ) ≤ p)] + nlinarith [mul_sqrt_add_one_le hε hb hd, + le_mul_of_one_le_right hA (one_le_sqrt.2 (by simp) : (1 : ℝ) ≤ √(d + 1)), + p.cast_nonneg (α := ℝ)] + +/-- The constant `b` of `add_mul_log_add_sqrt_le` for the error terms of +`exists_isMulticoloredSumFree_exp_le` is at most `2 ^ (p + 1) * p ^ 10`. -/ +private lemma log_mul_pow_add_le_two_pow_succ_mul {p : ℕ} (hp : 2 ≤ p) : + log p * p ^ 4 + 2 ^ p * p ^ 10 + (48 + 8 * p) + 2 * p + + 4 * √(log (12 + 2 * p) + 3 * log p) ≤ 2 ^ (p + 1) * p ^ 10 := by + have hp' : (2 : ℝ) ≤ p := by exact_mod_cast hp + have hsqrt : √(log (12 + 2 * p) + 3 * log p) ≤ 13 + 5 * p := by + rw [sqrt_le_left (by positivity)] + nlinarith [log_le_self (by positivity : (0 : ℝ) ≤ 12 + 2 * p), + log_le_self (by positivity : (0 : ℝ) ≤ p), log_nonneg (by linarith : (1 : ℝ) ≤ p), + log_nonneg (by linarith : (1 : ℝ) ≤ 12 + 2 * p)] + grw [hsqrt, log_le_self (by positivity : (0 : ℝ) ≤ p), pow_succ (2 : ℝ) p] + nlinarith [mul_le_mul_of_nonneg_right (pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 2) hp) + (by positivity : (0 : ℝ) ≤ p ^ 10), + mul_le_mul_of_nonneg_right (pow_le_pow_left₀ (by norm_num) hp' 5) + (by positivity : (0 : ℝ) ≤ p ^ 5), + le_self_pow₀ (by linarith : (1 : ℝ) ≤ p) (by norm_num : 5 ≠ 0)] + +/-- **Large multicolored sum-free families** (Kleinberg, Sawin and Speyer, using Pebody's theorem; +the second part of Theorem 2 of Fox and Lovász). For `p ≥ 2`, `η > 0` and +`d ≥ n₀ p η = ⌈(2 ^ (p + 3) * p ^ 10 / η) ^ 2⌉ + p ^ 4 + 1`, there is a multicolored sum-free +family in `Fin d → ZMod p` with at least `p ^ ((1 - c p - η) * d)` members. -/ +theorem exists_isMulticoloredSumFree_rpow_le {p d : ℕ} (hp : 2 ≤ p) {η : ℝ} (hη : 0 < η) + (hd : n₀ p η ≤ d) : + ∃ (m : ℕ) (x y z : Fin m → Fin d → ZMod p), + IsMulticoloredSumFree x y z ∧ (p : ℝ) ^ ((1 - c p - η) * d) ≤ m := by + have hlogp : 1 / 2 ≤ log p := by + linarith [one_sub_inv_le_log_of_pos (by norm_num : (0 : ℝ) < 2), + log_le_log (by norm_num) (by exact_mod_cast hp : (2 : ℝ) ≤ p)] + have hb : 2 * (log p * p ^ 4 + 2 ^ p * p ^ 10 + (48 + 8 * p) + 2 * p + + 4 * √(log (12 + 2 * p) + 3 * log p)) / (η * log p) ≤ 2 ^ (p + 3) * p ^ 10 / η := by + rw [div_le_div_iff₀ (by positivity) hη, pow_add] + grw [log_mul_pow_add_le_two_pow_succ_mul hp, pow_succ] + nlinarith [(by positivity : (0 : ℝ) ≤ 2 ^ p * p ^ 10 * η)] + obtain ⟨n, m, x, y, z, hsf, hn₁, hn₂, hm⟩ := + exists_isMulticoloredSumFree_exp_le hp ((pow_four_lt_n₀ p η).trans_le hd) + refine ⟨m, x, y, z, hsf, ?_⟩ + grw [← hm] + rw [rpow_def_of_pos (by positivity), le_div_iff₀ (by positivity), + ← exp_log (by positivity : (0 : ℝ) < 4 * (12 + 2 * p)), ← exp_add, exp_le_exp] + nlinarith [add_mul_log_add_sqrt_le hp (by positivity) (mul_pos hη (by linarith)) hb + ((sq_add_one_le_n₀ p η).trans (by exact_mod_cast hd)) (by exact_mod_cast hn₂ : n ≤ d), + mul_le_mul_of_nonneg_right hn₁ + (mul_nonneg (sub_nonneg.2 (c_lt_one hp).le) (by linarith : (0 : ℝ) ≤ log p)), + mul_nonneg (c_pos hp).le (by positivity : (0 : ℝ) ≤ log p * p ^ 4), + log_le_self (by positivity : (0 : ℝ) ≤ 4 * (12 + 2 * p))] + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/TypeClass.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/TypeClass.lean new file mode 100644 index 0000000000..ac4656291b --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Construction/TypeClass.lean @@ -0,0 +1,200 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import Mathlib.Analysis.SpecialFunctions.Log.Basic +public import Mathlib.Data.Fintype.Perm +import Mathlib.Analysis.SpecialFunctions.Log.Sum +import Mathlib.GroupTheory.Perm.DomMulAct + +/-! +# The size of a type class + +The type class of `a : Fin n → ℕ` is the set of the vectors `a ∘ σ` obtained by permuting its +entries. If the value `k` appears `D k` times in `a`, the type class has +`n.factorial / ∏ k, (D k).factorial` elements. This file bounds the logarithm of this number from +below by `∑ k, D k * log (ψ k)⁻¹`, up to an error controlled by +`∑ k, (D k - n * ψ k) ^ 2 / (n * ψ k)`, for every positive probability vector `ψ`. This is Lemma 3.1 +of Kleinberg, Sawin and Speyer, together with the comparison between entropy and cross entropy. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.typeClass a`: the vectors obtained by permuting the + entries of `a`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.card_typeClass_mul_prod_factorial`: the type class of + `a` has `n.factorial / ∏ k, (D k).factorial` elements. +* `ArithmeticTriangleRemovalInVectorSpaces.le_log_card_typeClass`: the lower bound on its + logarithm. +-/ + +public section + +open Finset Real + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {n N : ℕ} {a b b' : Fin n → ℕ} + +/-- The type class of `a`: the vectors `a ∘ σ` obtained by permuting the entries of `a`. -/ +@[expose] def typeClass (a : Fin n → ℕ) : Finset (Fin n → ℕ) := + univ.image fun σ : Equiv.Perm (Fin n) ↦ a ∘ σ + +private lemma mem_typeClass : b ∈ typeClass a ↔ ∃ σ : Equiv.Perm (Fin n), a ∘ σ = b := by + simp [typeClass] + +lemma self_mem_typeClass (a : Fin n → ℕ) : a ∈ typeClass a := + mem_typeClass.2 ⟨1, rfl⟩ + +@[simp] +lemma typeClass_nonempty (a : Fin n → ℕ) : (typeClass a).Nonempty := + ⟨a, self_mem_typeClass a⟩ + +lemma comp_mem_typeClass (hb : b ∈ typeClass a) (σ : Equiv.Perm (Fin n)) : + b ∘ σ ∈ typeClass a := by + obtain ⟨τ, rfl⟩ := mem_typeClass.1 hb + exact mem_typeClass.2 ⟨τ * σ, rfl⟩ + +lemma exists_eq_comp_of_mem_typeClass (hb : b ∈ typeClass a) (hb' : b' ∈ typeClass a) : + ∃ σ : Equiv.Perm (Fin n), b' = b ∘ σ := by + obtain ⟨τ, rfl⟩ := mem_typeClass.1 hb + obtain ⟨τ', rfl⟩ := mem_typeClass.1 hb' + refine ⟨τ⁻¹ * τ', ?_⟩ + ext r + simp + +lemma sum_eq_of_mem_typeClass (hb : b ∈ typeClass a) : ∑ r, b r = ∑ r, a r := by + obtain ⟨τ, rfl⟩ := mem_typeClass.1 hb + exact Equiv.sum_comp τ a + +lemma card_typeClass_le {p : ℕ} (ha : ∀ r, a r < p) : #(typeClass a) ≤ p ^ n := by + have hsub : typeClass a ⊆ Fintype.piFinset fun _ ↦ range p := by + intro b hb + obtain ⟨τ, rfl⟩ := mem_typeClass.1 hb + simp [ha] + grw [card_le_card hsub] + simp + +/-- The values `k ≤ N` of `a` appear `n` times in total. -/ +lemma sum_card_filter_eq (ha : ∀ r, a r ≤ N) : ∑ k ∈ range (N + 1), #{r | a r = k} = n := by + rw [← card_eq_sum_card_fiberwise (fun r _ ↦ mem_range.2 (by grind [ha r])), card_univ, + Fintype.card_fin] + +/-- The permutations `σ` with `a ∘ σ = a ∘ τ` are as many as those with `a ∘ σ = a`. -/ +private lemma card_filter_comp_eq_comp (a : Fin n → ℕ) (τ : Equiv.Perm (Fin n)) : + #{σ : Equiv.Perm (Fin n) | a ∘ σ = a ∘ τ} = + Fintype.card {σ : Equiv.Perm (Fin n) // a ∘ σ = a} := by + rw [← Fintype.card_subtype] + refine Fintype.card_congr ((Equiv.mulRight τ⁻¹).subtypeEquiv ?_) + intro σ + simp [Equiv.Perm.coe_mul, ← Function.comp_assoc, Equiv.Perm.inv_def, Equiv.comp_symm_eq] + +/-- **Orbit-stabilizer for type classes.** The type class of `a` times `∏ k, (D k).factorial` is +`n.factorial`. -/ +private lemma card_typeClass_mul_prod_factorial (a : Fin n → ℕ) (ha : ∀ r, a r ≤ N) : + #(typeClass a) * ∏ k ∈ range (N + 1), (#{r | a r = k}).factorial = n.factorial := by + have hprod : ∏ k ∈ range (N + 1), (#{r | a r = k}).factorial = + ∏ k ∈ univ.image a, (Fintype.card {r // a r = k}).factorial := by + simp_rw [Fintype.card_subtype] + refine (prod_subset ?_ ?_).symm + · intro k + simp only [mem_image, mem_univ, true_and, mem_range] + grind + · intro k _ hk + simp_all + rw [hprod, ← DomMulAct.stabilizer_card', + (by simp [Fintype.card_perm] : n.factorial = #(univ : Finset (Equiv.Perm (Fin n)))), + card_eq_sum_card_image fun σ : Equiv.Perm (Fin n) ↦ a ∘ σ, typeClass, sum_const_nat] + simp only [mem_image, mem_univ, true_and] + rintro _ ⟨τ, rfl⟩ + exact card_filter_comp_eq_comp a τ + +private lemma log_card_typeClass (a : Fin n → ℕ) (ha : ∀ r, a r ≤ N) : + log #(typeClass a) = + log n.factorial - ∑ k ∈ range (N + 1), log (#{r | a r = k}).factorial := by + rw [eq_sub_iff_add_eq, ← log_prod fun k _ ↦ by positivity, + ← log_mul (by simpa using (typeClass_nonempty a).ne_empty) (by positivity), + ← card_typeClass_mul_prod_factorial a ha] + push_cast + rfl + +/-- For `D ≤ n`, `D * log (n / D) - (1 + log (n + 1)) ≤ D * log n - D - log D.factorial`, from the +bound `log D.factorial ≤ D * log D - D + log D + 1`. -/ +private lemma mul_log_div_sub_le {D : ℕ} (hD : D ≤ n) : + D * log (n / D) - (1 + log (n + 1)) ≤ D * log n - D - log D.factorial := by + rcases D.eq_zero_or_pos with rfl | hD₀ + · simpa using (by linarith [log_nonneg (by simp : (1 : ℝ) ≤ n + 1)] : -log (n + 1 : ℝ) ≤ 1) + have h := sum_log_le (x := D) (by exact_mod_cast hD₀) + rw [Nat.floor_natCast, sum_log_eq_log_factorial] at h + rw [log_div (by norm_cast; grind) (by positivity)] + linarith [log_le_log (by positivity) (by norm_cast; grind : (D : ℝ) ≤ n + 1)] + +/-- The logarithm of a multinomial coefficient is at least the entropy term +`∑ k, D k * log (n / D k)` minus `#s * (1 + log (n + 1))`. -/ +private lemma sum_mul_log_div_sub_le_log {s : Finset ℕ} (D : ℕ → ℕ) (hD : ∑ k ∈ s, D k = n) : + ∑ k ∈ s, D k * log (n / D k) - #s * (1 + log (n + 1)) ≤ + log n.factorial - ∑ k ∈ s, log (D k).factorial := by + have h : ∑ k ∈ s, (D k * log (n / D k) - (1 + log (n + 1))) ≤ + ∑ k ∈ s, (D k * log n - D k - log (D k).factorial) := by + apply sum_le_sum + intro k hk + exact mul_log_div_sub_le (hD ▸ single_le_sum (by simp) hk) + simp only [sum_sub_distrib, sum_const, nsmul_eq_mul, ← sum_mul, + (by exact_mod_cast hD : ∑ k ∈ s, (D k : ℝ) = n)] at h + linarith [le_sum_log_nat n, sum_log_eq_log_factorial n] + +/-- For `0 ≤ D ≤ x` and `ψ > 0`, +`D * log ψ⁻¹ - (D - x * ψ) ^ 2 / (x * ψ) - (D - x * ψ) ≤ D * log (x / D)`, from the bound +`1 - y⁻¹ ≤ log y`. -/ +private lemma mul_log_inv_sub_sq_div_sub_le {D x ψ : ℝ} (hD : 0 ≤ D) (hDx : D ≤ x) (hψ : 0 < ψ) : + D * log ψ⁻¹ - (D - x * ψ) ^ 2 / (x * ψ) - (D - x * ψ) ≤ D * log (x / D) := by + rcases hD.eq_or_lt with rfl | hD + · simp [sq] + have hx : 0 < x := hD.trans_le hDx + have hxψ : 0 < x * ψ := by positivity + have hlog := one_sub_inv_le_log_of_pos (div_pos hxψ hD) + rw [inv_div, log_div hxψ.ne' hD.ne', log_mul (by positivity) hψ.ne'] at hlog + rw [log_div (by positivity) hD.ne', log_inv] + have hid : D * (1 - D / (x * ψ)) = -((D - x * ψ) ^ 2 / (x * ψ)) - (D - x * ψ) := by + field_simp + ring + linarith [mul_le_mul_of_nonneg_left hlog hD.le] + +/-- **Entropy and cross entropy.** For a positive probability vector `ψ` and counts `D` summing to +`n`, `∑ k, D k * log (n / D k)` is at least +`∑ k, D k * log (ψ k)⁻¹ - ∑ k, (D k - n * ψ k) ^ 2 / (n * ψ k)`. -/ +private lemma sum_mul_log_inv_sub_le {s : Finset ℕ} (D : ℕ → ℕ) (hD : ∑ k ∈ s, D k = n) {ψ : ℕ → ℝ} + (hψ : ∀ k ∈ s, 0 < ψ k) (hψ₁ : ∑ k ∈ s, ψ k = 1) : + ∑ k ∈ s, D k * log (ψ k)⁻¹ - ∑ k ∈ s, (D k - n * ψ k) ^ 2 / (n * ψ k) ≤ + ∑ k ∈ s, D k * log (n / D k) := by + have hY : ∑ k ∈ s, ((D k : ℝ) - n * ψ k) = 0 := by + rw [sum_sub_distrib, ← mul_sum, hψ₁, mul_one, sub_eq_zero] + exact_mod_cast hD + have h : ∑ k ∈ s, (D k * log (ψ k)⁻¹ - (D k - n * ψ k) ^ 2 / (n * ψ k) - (D k - n * ψ k)) ≤ + ∑ k ∈ s, D k * log (n / D k) := by + apply sum_le_sum + intro k hk + exact mul_log_inv_sub_sq_div_sub_le (by positivity) + (by exact_mod_cast hD ▸ single_le_sum (by simp) hk) (hψ k hk) + rwa [sum_sub_distrib, hY, sub_zero, sum_sub_distrib] at h + +/-- **Lower bound for the size of a type class.** If the value `k ≤ N` appears `D k` times in +`a : Fin n → ℕ` and `ψ` is a positive probability vector on `range (N + 1)`, then +`log #(typeClass a)` is at least +`∑ k, D k * log (ψ k)⁻¹ - ∑ k, (D k - n * ψ k) ^ 2 / (n * ψ k) - (N + 1) * (1 + log (n + 1))`. -/ +lemma le_log_card_typeClass (a : Fin n → ℕ) (ha : ∀ r, a r ≤ N) {ψ : ℕ → ℝ} + (hψ : ∀ k ∈ range (N + 1), 0 < ψ k) (hψ₁ : ∑ k ∈ range (N + 1), ψ k = 1) : + ∑ k ∈ range (N + 1), #{r | a r = k} * log (ψ k)⁻¹ - + ∑ k ∈ range (N + 1), (#{r | a r = k} - n * ψ k) ^ 2 / (n * ψ k) - + (N + 1) * (1 + log (n + 1)) ≤ log #(typeClass a) := by + have h := sum_mul_log_div_sub_le_log _ (sum_card_filter_eq ha) + rw [card_range, Nat.cast_add_one] at h + rw [log_card_typeClass a ha] + linarith [sum_mul_log_inv_sub_le _ (sum_card_filter_eq ha) hψ hψ₁] + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Basic.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Basic.lean new file mode 100644 index 0000000000..1926dd8cce --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Basic.lean @@ -0,0 +1,232 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import Mathlib.Algebra.BigOperators.Group.Finset.Defs +public import Mathlib.Basic.Real.Basic +import Mathlib.Analysis.SpecialFunctions.Pow.Real + +/-! +# Compatible mass functions + +Three mass functions `π₁`, `π₂` and `π₃` on `ℕ` are compatible at level `N` if they are the +marginals of a nonnegative function on the triples `(a, b, c)` of natural numbers with +`a + b + c = N`. For probability distributions, this says that there are random variables `X₁`, `X₂` +and `X₃` with distributions `π₁`, `π₂` and `π₃` such that `X₁ + X₂ + X₃ = N`. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.sumTriples N`: the triples of natural numbers with sum + `N`. +* `ArithmeticTriangleRemovalInVectorSpaces.marginal N J g`: the push-forward of `J` along `g`. +* `ArithmeticTriangleRemovalInVectorSpaces.Compatible N π₁ π₂ π₃`: `π₁`, `π₂` and `π₃` are + compatible at level `N`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.Compatible.add` and + `ArithmeticTriangleRemovalInVectorSpaces.Compatible.smul`: compatible triples form a convex cone. +* `ArithmeticTriangleRemovalInVectorSpaces.Compatible.comm₁₂` and + `ArithmeticTriangleRemovalInVectorSpaces.Compatible.comm₂₃`: compatibility does not depend on the + order of the mass functions. +* `ArithmeticTriangleRemovalInVectorSpaces.Compatible.shift`: adding `d` to the third variable + raises the level by `d`. +* `ArithmeticTriangleRemovalInVectorSpaces.compatible_layer`: the triples `(0, b, N - b)` with + weights `f b`. +-/ + +public section + +open Finset + +namespace ArithmeticTriangleRemovalInVectorSpaces + +/-- The triples `(a, b, c)` of natural numbers with `a + b + c = N`. -/ +def sumTriples (N : ℕ) : Finset (ℕ × ℕ × ℕ) := + (range (N + 1) ×ˢ range (N + 1) ×ˢ range (N + 1)).filter fun (a, b, c) ↦ a + b + c = N + +@[simp] +lemma mem_sumTriples {N a b c : ℕ} : (a, b, c) ∈ sumTriples N ↔ a + b + c = N := by + simp only [sumTriples, mem_filter, mem_product, mem_range] + grind + +/-- The push-forward of `J`, restricted to the triples with sum `N`, along `g`. -/ +@[expose] def marginal (N : ℕ) (J : ℕ × ℕ × ℕ → ℝ) (g : ℕ × ℕ × ℕ → ℕ) (k : ℕ) : ℝ := + ∑ x ∈ sumTriples N with g x = k, J x + +/-- Three mass functions on `ℕ` are compatible at level `N` if they are the marginals of a +nonnegative function on the triples with sum `N`. -/ +@[expose] def Compatible (N : ℕ) (π₁ π₂ π₃ : ℕ → ℝ) : Prop := + ∃ J : ℕ × ℕ × ℕ → ℝ, (∀ x, 0 ≤ J x) ∧ marginal N J (fun (a, _, _) ↦ a) = π₁ ∧ + marginal N J (fun (_, b, _) ↦ b) = π₂ ∧ marginal N J (fun (_, _, c) ↦ c) = π₃ + +variable {N : ℕ} {J J' : ℕ × ℕ × ℕ → ℝ} {g : ℕ × ℕ × ℕ → ℕ} {π₁ π₂ π₃ π₁' π₂' π₃' : ℕ → ℝ} + +private lemma marginal_add : marginal N (J + J') g = marginal N J g + marginal N J' g := by + ext k + simp [marginal, sum_add_distrib] + +lemma marginal_smul (r : ℝ) : marginal N (r • J) g = r • marginal N J g := by + ext k + simp [marginal, mul_sum] + +/-- Precomposing `J` with an involution of the triples that preserves `sumTriples N` amounts to +precomposing `g` with it. -/ +private lemma marginal_comp {e : ℕ × ℕ × ℕ → ℕ × ℕ × ℕ} (he : ∀ x, e (e x) = x) + (hs : ∀ x, e x ∈ sumTriples N ↔ x ∈ sumTriples N) : + marginal N (J ∘ e) g = marginal N J (g ∘ e) := by + ext k + refine sum_nbij' e e ?_ ?_ (fun x _ ↦ he x) (fun x _ ↦ he x) (fun _ _ ↦ rfl) + all_goals + intro x hx + simpa [hs, he] using hx + +lemma compatible_zero : Compatible N 0 0 0 := + ⟨0, fun _ ↦ le_rfl, by ext; simp [marginal], by ext; simp [marginal], by ext; simp [marginal]⟩ + +lemma Compatible.add (h : Compatible N π₁ π₂ π₃) (h' : Compatible N π₁' π₂' π₃') : + Compatible N (π₁ + π₁') (π₂ + π₂') (π₃ + π₃') := by + obtain ⟨J, hJ, rfl, rfl, rfl⟩ := h + obtain ⟨J', hJ', rfl, rfl, rfl⟩ := h' + exact ⟨J + J', fun x ↦ add_nonneg (hJ x) (hJ' x), marginal_add, marginal_add, marginal_add⟩ + +lemma Compatible.smul (h : Compatible N π₁ π₂ π₃) {r : ℝ} (hr : 0 ≤ r) : + Compatible N (r • π₁) (r • π₂) (r • π₃) := by + obtain ⟨J, hJ, rfl, rfl, rfl⟩ := h + exact ⟨r • J, fun x ↦ mul_nonneg hr (hJ x), marginal_smul r, marginal_smul r, marginal_smul r⟩ + +lemma Compatible.comm₁₂ (h : Compatible N π₁ π₂ π₃) : Compatible N π₂ π₁ π₃ := by + obtain ⟨J, hJ, rfl, rfl, rfl⟩ := h + have hcomp (g) := marginal_comp (N := N) (J := J) (g := g) (e := fun (a, b, c) ↦ (b, a, c)) + (fun _ ↦ rfl) (by simp [add_comm]) + exact ⟨_, fun x ↦ hJ _, hcomp _, hcomp _, hcomp _⟩ + +lemma Compatible.comm₂₃ (h : Compatible N π₁ π₂ π₃) : Compatible N π₁ π₃ π₂ := by + obtain ⟨J, hJ, rfl, rfl, rfl⟩ := h + have hcomp (g) := marginal_comp (N := N) (J := J) (g := g) (e := fun (a, b, c) ↦ (a, c, b)) + (fun _ ↦ rfl) (by simp [add_right_comm]) + exact ⟨_, fun x ↦ hJ _, hcomp _, hcomp _, hcomp _⟩ + +lemma Compatible.comm₁₃ (h : Compatible N π₁ π₂ π₃) : Compatible N π₃ π₂ π₁ := + h.comm₁₂.comm₂₃.comm₁₂ + +/-- The function `J` with `d` added to the third variable. -/ +private def shiftThird (d : ℕ) (J : ℕ × ℕ × ℕ → ℝ) : ℕ × ℕ × ℕ → ℝ := + fun (a, b, c) ↦ if d ≤ c then J (a, b, c - d) else 0 + +private lemma marginal_shiftThird (d k : ℕ) : + marginal (N + d) (shiftThird d J) g k = + ∑ x ∈ sumTriples N with g (x + (0, 0, d)) = k, J x := by + rw [marginal, ← sum_filter_of_ne (p := fun (_, _, c) ↦ d ≤ c), filter_filter] + · refine sum_nbij' (· - (0, 0, d)) (· + (0, 0, d)) ?_ ?_ ?_ ?_ ?_ + all_goals + rintro ⟨a, b, c⟩ hx + simp only [mem_filter, mem_sumTriples, Prod.mk_sub_mk, Prod.mk_add_mk, add_zero, + tsub_zero] at hx ⊢ + · obtain ⟨h₁, rfl, h₃⟩ := hx + rw [Nat.sub_add_cancel h₃] + grind + · grind + · obtain ⟨-, -, h₃⟩ := hx + rw [Nat.sub_add_cancel h₃] + · simp + · obtain ⟨-, -, h₃⟩ := hx + simp [shiftThird, h₃] + · rintro ⟨a, b, c⟩ - hne + by_contra h + simp [shiftThird, h] at hne + +/-- Adding `d` to the third variable raises the level by `d`. -/ +lemma Compatible.shift (h : Compatible N π₁ π₂ π₃) (d : ℕ) : + Compatible (N + d) π₁ π₂ fun c ↦ if d ≤ c then π₃ (c - d) else 0 := by + obtain ⟨J, hJ, rfl, rfl, rfl⟩ := h + refine ⟨shiftThird d J, ?_, ?_, ?_, ?_⟩ + · rintro ⟨a, b, c⟩ + unfold shiftThird + grind + · ext k + rw [marginal_shiftThird] + rfl + · ext k + rw [marginal_shiftThird] + rfl + · ext k + rw [marginal_shiftThird, marginal] + by_cases hk : d ≤ k + · simp only [hk, ↓reduceIte] + congr 1 + ext ⟨a, b, c⟩ + simp only [mem_filter] + grind + · simp only [hk, ↓reduceIte] + apply sum_eq_zero + rintro ⟨a, b, c⟩ hx + simp only [mem_filter] at hx + grind + +/-- The triples `(0, b, N - b)` with weights `f b`. -/ +lemma compatible_layer {f : ℕ → ℝ} (hf : ∀ k, 0 ≤ f k) : + Compatible N (fun a ↦ if a = 0 then ∑ k ∈ range (N + 1), f k else 0) + (fun b ↦ if b ≤ N then f b else 0) fun c ↦ if c ≤ N then f (N - c) else 0 := by + refine ⟨fun (a, b, _) ↦ if a = 0 then f b else 0, ?_, ?_, ?_, ?_⟩ + · rintro ⟨a, b, c⟩ + grind + · ext a + simp only [marginal] + by_cases ha : a = 0 + · simp only [ha, ↓reduceIte] + subst ha + refine sum_nbij' (fun (_, b, _) ↦ b) (fun b ↦ (0, b, N - b)) ?_ ?_ ?_ ?_ ?_ + · rintro ⟨a, b, c⟩ hx + simp only [mem_filter, mem_sumTriples, mem_range] at hx ⊢ + grind + · intro b hb + simp only [mem_range] at hb + simp only [mem_filter, mem_sumTriples] + grind + · rintro ⟨a, b, c⟩ hx + simp only [mem_filter, mem_sumTriples] at hx + grind + · intro b _ + rfl + · rintro ⟨a, b, c⟩ hx + simp only [mem_filter, mem_sumTriples] at hx + grind + · simp only [ha, ↓reduceIte] + apply sum_eq_zero + rintro ⟨a', b, c⟩ hx + simp only [mem_filter] at hx + grind + · ext b + simp only [marginal] + by_cases hb : b ≤ N + · simp only [hb, ↓reduceIte] + rw [sum_eq_single_of_mem (0, b, N - b) (by simp; grind)] + · simp + · rintro ⟨a, b', c⟩ hx hne + simp only [mem_filter, mem_sumTriples] at hx + grind + · simp only [hb, ↓reduceIte] + apply sum_eq_zero + rintro ⟨a, b', c⟩ hx + simp only [mem_filter, mem_sumTriples] at hx + grind + · ext c + simp only [marginal] + by_cases hc : c ≤ N + · simp only [hc, ↓reduceIte] + rw [sum_eq_single_of_mem (0, N - c, c) (by simp; grind)] + · simp + · rintro ⟨a, b, c'⟩ hx hne + simp only [mem_filter, mem_sumTriples] at hx + grind + · simp only [hc, ↓reduceIte] + apply sum_eq_zero + rintro ⟨a, b, c'⟩ hx + simp only [mem_filter, mem_sumTriples] at hx + grind + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Decomposition.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Decomposition.lean new file mode 100644 index 0000000000..0902d382f0 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Decomposition.lean @@ -0,0 +1,309 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Coupling.Uniform +import Mathlib.Analysis.SpecialFunctions.Pow.Real + +/-! +# Decomposition into simple triples + +Three weights on `[0, N]` with equal masses whose first moments sum to `2 * N` times the mass are a +nonnegative combination of simple triples: two point masses and a combination of two point masses. +This is Lemma 2.1 of Pebody. Applying `hat` to the simple triples gives the triples handled in +`ArithmeticTriangleRemovalInVectorSpaces.compatible_unif_mix`, so the `hat` of a balanced triple of +weights is compatible. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.IsWeight N w`: `w` is nonnegative and vanishes beyond + `N`. +* `ArithmeticTriangleRemovalInVectorSpaces.IsBalanced N w₁ w₂ w₃`: the weights have equal masses and + their first moments sum to `2 * N` times the mass. +* `ArithmeticTriangleRemovalInVectorSpaces.IsUnitBelow N w σ μ`: `σ` is a weight of mass one and + first moment `μ` supported in the support of `w`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.IsBalanced.compatible_hat`: the `hat` of a balanced + triple of weights is compatible, given Pebody's theorem at lower levels. +-/ + +public section + +open Finset Function + +namespace ArithmeticTriangleRemovalInVectorSpaces + +/-- A weight on `[0, N]`: a nonnegative function vanishing beyond `N`. -/ +@[expose] def IsWeight (N : ℕ) (w : ℕ → ℝ) : Prop := + (∀ k, 0 ≤ w k) ∧ ∀ k, N < k → w k = 0 + +/-- Three weights on `[0, N]` with equal masses whose first moments sum to `2 * N` times the +mass. -/ +@[expose] def IsBalanced (N : ℕ) (w₁ w₂ w₃ : ℕ → ℝ) : Prop := + IsWeight N w₁ ∧ IsWeight N w₂ ∧ IsWeight N w₃ ∧ mass N w₂ = mass N w₁ ∧ + mass N w₃ = mass N w₁ ∧ moment N w₁ + moment N w₂ + moment N w₃ = 2 * N * mass N w₁ + +/-- `σ` is a weight of mass one and first moment `μ` whose support lies in the support of `w`. -/ +private def IsUnitBelow (N : ℕ) (w σ : ℕ → ℝ) (μ : ℝ) : Prop := + IsWeight N σ ∧ mass N σ = 1 ∧ moment N σ = μ ∧ support σ ⊆ support w + +/-- The number of points of `[0, N]` where `w` does not vanish. -/ +private noncomputable def supportCard (N : ℕ) (w : ℕ → ℝ) : ℕ := + #{k ∈ range (N + 1) | w k ≠ 0} + +variable {N : ℕ} {w w₁ w₂ w₃ σ σ₁ σ₂ σ₃ : ℕ → ℝ} {μ μ₁ μ₂ μ₃ p : ℝ} + +private lemma IsWeight.mass_nonneg (hw : IsWeight N w) : 0 ≤ mass N w := by + obtain ⟨hw₀, -⟩ := hw + apply sum_nonneg + intro k _ + exact hw₀ k + +private lemma IsWeight.hat_eq_zero (hw : IsWeight N w) (h0 : mass N w = 0) : hat N w = 0 := by + obtain ⟨hw₀, -⟩ := hw + ext j + apply sum_eq_zero + intro k hk + rw [(sum_eq_zero_iff_of_nonneg fun k _ ↦ hw₀ k).1 h0 k hk, zero_mul] + +private lemma IsWeight.sub (hw : IsWeight N w) (hσ : IsWeight N σ) (hle : ∀ k, p * σ k ≤ w k) : + IsWeight N (w - p • σ) := by + obtain ⟨-, hwN⟩ := hw + obtain ⟨-, hσN⟩ := hσ + exact ⟨fun k ↦ sub_nonneg.2 (hle k), fun k hk ↦ by simp [hwN k hk, hσN k hk]⟩ + +/-- A weight of positive mass has points of its support on both sides of its mean. -/ +private lemma IsWeight.exists_le_moment_le (hw : IsWeight N w) (hM : mass N w ≠ 0) : + (∃ a ≤ N, w a ≠ 0 ∧ a * mass N w ≤ moment N w) ∧ + ∃ b ≤ N, w b ≠ 0 ∧ moment N w ≤ b * mass N w := by + obtain ⟨hw₀, -⟩ := hw + set s := {k ∈ range (N + 1) | w k ≠ 0} + obtain ⟨k, hk, hwk⟩ := exists_ne_zero_of_sum_ne_zero hM + have hs : s.Nonempty := ⟨k, mem_filter.2 ⟨hk, hwk⟩⟩ + have heq : ∑ k ∈ s, w k * (k * mass N w) = ∑ k ∈ s, w k * moment N w := by + simp only [mass, moment] + rw [sum_filter_of_ne fun k _ h ↦ left_ne_zero_of_mul h, + sum_filter_of_ne fun k _ h ↦ left_ne_zero_of_mul h] + simp_rw [mul_left_comm (w _), ← mul_assoc, ← sum_mul] + ring + obtain ⟨a, ha, hle⟩ := exists_le_of_sum_le hs heq.le + obtain ⟨b, hb, hge⟩ := exists_le_of_sum_le hs heq.ge + simp only [s, mem_filter, mem_range] at ha hb + obtain ⟨ha, hwa⟩ := ha + obtain ⟨hb, hwb⟩ := hb + exact ⟨⟨a, by grind, hwa, le_of_mul_le_mul_left hle ((hw₀ a).lt_of_ne' hwa)⟩, + ⟨b, by grind, hwb, le_of_mul_le_mul_left hge ((hw₀ b).lt_of_ne' hwb)⟩⟩ + +private lemma isUnitBelow_single {c : ℕ} (hc : c ≤ N) (hw : w c ≠ 0) : + IsUnitBelow N w (Pi.single c 1) c := by + refine ⟨⟨Pi.single_nonneg.2 zero_le_one, fun _ hk ↦ Pi.single_eq_of_ne (by grind) _⟩, + by simp [mass, Nat.lt_succ_of_le hc], by simp [moment, Pi.single_apply, Nat.lt_succ_of_le hc], + ?_⟩ + exact Pi.support_single_subset.trans (Set.singleton_subset_iff.2 hw) + +private lemma isUnitBelow_mix {y z : ℕ} (hy : y ≤ N) (hz : z ≤ N) {α : ℝ} (hα₀ : 0 ≤ α) + (hα₁ : α ≤ 1) (hwy : w y ≠ 0) (hwz : w z ≠ 0) : + IsUnitBelow N w (α • (Pi.single y 1 : ℕ → ℝ) + (1 - α) • (Pi.single z 1 : ℕ → ℝ)) + (α * y + (1 - α) * z) := by + obtain ⟨⟨hy₀, hyN⟩, hy₁, hyμ, hys⟩ := isUnitBelow_single hy hwy + obtain ⟨⟨hz₀, hzN⟩, hz₁, hzμ, hzs⟩ := isUnitBelow_single hz hwz + refine ⟨⟨?_, ?_⟩, ?_, ?_, ?_⟩ + · intro k + exact add_nonneg (mul_nonneg hα₀ (hy₀ k)) (mul_nonneg (by linarith) (hz₀ k)) + · intro k hk + simp [hyN k hk, hzN k hk] + · rw [mass_add, mass_smul, mass_smul, hy₁, hz₁] + ring + · rw [moment_add, moment_smul, moment_smul, hyμ, hzμ] + · exact (support_add _ _).trans (Set.union_subset ((support_const_smul_subset _ _).trans hys) + ((support_const_smul_subset _ _).trans hzs)) + +private lemma IsUnitBelow.mass_sub_smul (hσ : IsUnitBelow N w σ μ) : + mass N (w - p • σ) = mass N w - p := by + obtain ⟨-, hσ₁, -, -⟩ := hσ + rw [mass_sub, mass_smul, hσ₁, mul_one] + +private lemma IsUnitBelow.moment_sub_smul (hσ : IsUnitBelow N w σ μ) : + moment N (w - p • σ) = moment N w - p * μ := by + obtain ⟨-, -, hσμ, -⟩ := hσ + rw [moment_sub, moment_smul, hσμ] + +/-- The largest multiple of `σ` below `w` touches `w` at a point of the support of `σ`. -/ +private lemma IsUnitBelow.exists_ratio (hσ : IsUnitBelow N w σ μ) (hw : IsWeight N w) : + ∃ r > 0, (∀ k, r * σ k ≤ w k) ∧ ∃ k ≤ N, σ k ≠ 0 ∧ r * σ k = w k := by + obtain ⟨⟨hσ₀, hσN⟩, hσ₁, -, hσs⟩ := hσ + obtain ⟨hw₀, -⟩ := hw + set s := {k ∈ range (N + 1) | σ k ≠ 0} + obtain ⟨k, hk, hσk⟩ := exists_ne_zero_of_sum_ne_zero (hσ₁.trans_ne one_ne_zero) + have hs : s.Nonempty := ⟨k, mem_filter.2 ⟨hk, hσk⟩⟩ + obtain ⟨k₀, hk₀, heq⟩ := exists_mem_eq_inf' hs fun k ↦ w k / σ k + simp only [s, mem_filter, mem_range] at hk₀ + obtain ⟨hk₀N, hσk₀⟩ := hk₀ + refine ⟨s.inf' hs fun k ↦ w k / σ k, ?_, ?_, k₀, by grind, hσk₀, ?_⟩ + · rw [gt_iff_lt, lt_inf'_iff] + intro k hk + simp only [s, mem_filter] at hk + obtain ⟨-, hσk⟩ := hk + exact div_pos ((hw₀ k).lt_of_ne' (hσs hσk)) ((hσ₀ k).lt_of_ne' hσk) + · intro k + by_cases hσk : σ k = 0 + · rw [hσk, mul_zero] + exact hw₀ k + · rw [← le_div_iff₀ ((hσ₀ k).lt_of_ne' hσk)] + apply inf'_le + simp only [s, mem_filter, mem_range] + exact ⟨by_contra fun h ↦ hσk (hσN k (by grind)), hσk⟩ + · rw [heq] + field_simp [hσk₀] + +private lemma IsUnitBelow.mul_le (hσ : IsUnitBelow N w σ μ) {r : ℝ} (hpr : p ≤ r) + (hr : ∀ k, r * σ k ≤ w k) (k : ℕ) : p * σ k ≤ w k := by + obtain ⟨⟨hσ₀, -⟩, -⟩ := hσ + grw [hpr] + · exact hr k + · exact hσ₀ k + +private lemma IsUnitBelow.support_sub_subset (hσ : IsUnitBelow N w σ μ) : + {k ∈ range (N + 1) | (w - p • σ) k ≠ 0} ⊆ {k ∈ range (N + 1) | w k ≠ 0} := by + obtain ⟨-, -, -, hσs⟩ := hσ + have hsub : support (w - p • σ) ⊆ support w := + (support_sub _ _).trans (Set.union_subset subset_rfl + ((support_const_smul_subset _ _).trans hσs)) + intro k + simp only [mem_filter] + rintro ⟨hk, hne⟩ + exact ⟨hk, hsub hne⟩ + +private lemma IsUnitBelow.supportCard_sub_le (hσ : IsUnitBelow N w σ μ) : + supportCard N (w - p • σ) ≤ supportCard N w := + card_le_card hσ.support_sub_subset + +private lemma IsUnitBelow.supportCard_sub_lt (hσ : IsUnitBelow N w σ μ) {k : ℕ} (hk : k ≤ N) + (hσk : σ k ≠ 0) (hpk : p * σ k = w k) : supportCard N (w - p • σ) < supportCard N w := by + have ⟨_, _, _, hσs⟩ := hσ + refine card_lt_card ((ssubset_iff_of_subset hσ.support_sub_subset).2 ⟨k, ?_, ?_⟩) + · simp only [mem_filter, mem_range] + exact ⟨by grind, hσs hσk⟩ + · simp [hpk] + +private lemma IsBalanced.sub (hb : IsBalanced N w₁ w₂ w₃) (h₁ : IsUnitBelow N w₁ σ₁ μ₁) + (h₂ : IsUnitBelow N w₂ σ₂ μ₂) (h₃ : IsUnitBelow N w₃ σ₃ μ₃) (hμ : μ₁ + μ₂ + μ₃ = 2 * N) + (hle₁ : ∀ k, p * σ₁ k ≤ w₁ k) (hle₂ : ∀ k, p * σ₂ k ≤ w₂ k) (hle₃ : ∀ k, p * σ₃ k ≤ w₃ k) : + IsBalanced N (w₁ - p • σ₁) (w₂ - p • σ₂) (w₃ - p • σ₃) := by + obtain ⟨hw₁, hw₂, hw₃, hm₂, hm₃, hmom⟩ := hb + have ⟨hσ₁, _⟩ := h₁ + have ⟨hσ₂, _⟩ := h₂ + have ⟨hσ₃, _⟩ := h₃ + refine ⟨hw₁.sub hσ₁ hle₁, hw₂.sub hσ₂ hle₂, hw₃.sub hσ₃ hle₃, ?_, ?_, ?_⟩ + · rw [h₂.mass_sub_smul, h₁.mass_sub_smul, hm₂] + · rw [h₃.mass_sub_smul, h₁.mass_sub_smul, hm₃] + · rw [h₁.moment_sub_smul, h₂.moment_sub_smul, h₃.moment_sub_smul, h₁.mass_sub_smul] + linear_combination hmom - p * hμ + +lemma IsBalanced.comm₂₃ (hb : IsBalanced N w₁ w₂ w₃) : IsBalanced N w₁ w₃ w₂ := by + obtain ⟨hw₁, hw₂, hw₃, hm₂, hm₃, hmom⟩ := hb + exact ⟨hw₁, hw₃, hw₂, hm₃, hm₂, by linarith⟩ + +lemma IsBalanced.comm₁₃ (hb : IsBalanced N w₁ w₂ w₃) : IsBalanced N w₃ w₂ w₁ := by + obtain ⟨hw₁, hw₂, hw₃, hm₂, hm₃, hmom⟩ := hb + refine ⟨hw₃, hw₂, hw₁, hm₂.trans hm₃.symm, hm₃.symm, ?_⟩ + rw [hm₃] + linarith + +/-- Subtracting the largest multiple of a compatible triple of unit weights lowers the total support +size, so the induction hypothesis applies to what is left. -/ +private lemma IsBalanced.compatible_hat_of_isUnitBelow (hb : IsBalanced N w₁ w₂ w₃) + (h₁ : IsUnitBelow N w₁ σ₁ μ₁) (h₂ : IsUnitBelow N w₂ σ₂ μ₂) (h₃ : IsUnitBelow N w₃ σ₃ μ₃) + (hμ : μ₁ + μ₂ + μ₃ = 2 * N) (hs : Compatible N (hat N σ₁) (hat N σ₂) (hat N σ₃)) + (IH : ∀ v₁ v₂ v₃, IsBalanced N v₁ v₂ v₃ → + supportCard N v₁ + supportCard N v₂ + supportCard N v₃ < + supportCard N w₁ + supportCard N w₂ + supportCard N w₃ → + Compatible N (hat N v₁) (hat N v₂) (hat N v₃)) : + Compatible N (hat N w₁) (hat N w₂) (hat N w₃) := by + have ⟨hw₁, hw₂, hw₃, _⟩ := hb + obtain ⟨r₁, hr₁, hle₁, k₁, hk₁, hσk₁, heq₁⟩ := h₁.exists_ratio hw₁ + obtain ⟨r₂, hr₂, hle₂, k₂, hk₂, hσk₂, heq₂⟩ := h₂.exists_ratio hw₂ + obtain ⟨r₃, hr₃, hle₃, k₃, hk₃, hσk₃, heq₃⟩ := h₃.exists_ratio hw₃ + set p := min (min r₁ r₂) r₃ with hp + have hcomp := (IH _ _ _ (hb.sub h₁ h₂ h₃ hμ + (h₁.mul_le (p := p) ((min_le_left _ _).trans (min_le_left _ _)) hle₁) + (h₂.mul_le (p := p) ((min_le_left _ _).trans (min_le_right _ _)) hle₂) + (h₃.mul_le (p := p) (min_le_right _ _) hle₃)) ?_).add (hs.smul (by positivity : 0 ≤ p)) + · simpa only [← hat_smul, ← hat_add, sub_add_cancel] using hcomp + obtain hp | hp | hp : p = r₁ ∨ p = r₂ ∨ p = r₃ := by grind + · grind [h₁.supportCard_sub_lt hk₁ hσk₁ (hp ▸ heq₁), h₂.supportCard_sub_le (p := p), + h₃.supportCard_sub_le (p := p)] + · grind [h₁.supportCard_sub_le (p := p), h₂.supportCard_sub_lt hk₂ hσk₂ (hp ▸ heq₂), + h₃.supportCard_sub_le (p := p)] + · grind [h₁.supportCard_sub_le (p := p), h₂.supportCard_sub_le (p := p), + h₃.supportCard_sub_lt hk₃ hσk₃ (hp ▸ heq₃)] + +private lemma exists_mix {c d y z : ℕ} (h₁ : c + d + y ≤ 2 * N) (h₂ : 2 * N ≤ c + d + z) : + ∃ α : ℝ, 0 ≤ α ∧ α ≤ 1 ∧ (c + d + α * y + (1 - α) * z : ℝ) = 2 * N := by + have h₁' : (c + d + y : ℝ) ≤ 2 * N := by exact_mod_cast h₁ + have h₂' : (2 * N : ℝ) ≤ c + d + z := by exact_mod_cast h₂ + obtain ⟨α, ⟨hα₀, hα₁⟩, hα⟩ := intermediate_value_Icc' zero_le_one + (by fun_prop : Continuous fun α : ℝ ↦ (c + d + α * y + (1 - α) * z : ℝ)).continuousOn + ⟨by simpa using h₁', by simpa using h₂'⟩ + exact ⟨α, hα₀, hα₁, hα⟩ + +/-- The step of the decomposition where the mixed point masses sit in the third weight. -/ +private lemma IsBalanced.compatible_hat_of_mix (ih : ∀ m < N, DecreasingCompatible m) + (hb : IsBalanced N w₁ w₂ w₃) {n : ℕ} + (hn : supportCard N w₁ + supportCard N w₂ + supportCard N w₃ ≤ n) + (IH : ∀ m < n, ∀ v₁ v₂ v₃, IsBalanced N v₁ v₂ v₃ → + supportCard N v₁ + supportCard N v₂ + supportCard N v₃ ≤ m → + Compatible N (hat N v₁) (hat N v₂) (hat N v₃)) + {c d y z : ℕ} (hc : c ≤ N) (hd : d ≤ N) (hy : y ≤ N) (hz : z ≤ N) (hwc : w₁ c ≠ 0) + (hwd : w₂ d ≠ 0) (hwy : w₃ y ≠ 0) (hwz : w₃ z ≠ 0) (h₁ : c + d + y ≤ 2 * N) + (h₂ : 2 * N ≤ c + d + z) : Compatible N (hat N w₁) (hat N w₂) (hat N w₃) := by + obtain ⟨α, hα₀, hα₁, hsum⟩ := exists_mix h₁ h₂ + refine hb.compatible_hat_of_isUnitBelow (isUnitBelow_single hc hwc) (isUnitBelow_single hd hwd) + (isUnitBelow_mix hy hz hα₀ hα₁ hwy hwz) (by linarith) ?_ ?_ + · rw [hat_single hc, hat_single hd, hat_add, hat_smul, hat_smul, hat_single hy, hat_single hz] + exact compatible_unif_mix ih hc hd hy hz hα₀ hα₁ hsum + · intro v₁ v₂ v₃ hv hlt + exact IH _ (by grind) _ _ _ hv le_rfl + +private lemma IsBalanced.compatible_hat_of_le (ih : ∀ m < N, DecreasingCompatible m) + (hb : IsBalanced N w₁ w₂ w₃) (n : ℕ) + (hn : supportCard N w₁ + supportCard N w₂ + supportCard N w₃ ≤ n) : + Compatible N (hat N w₁) (hat N w₂) (hat N w₃) := by + induction n using Nat.strong_induction_on generalizing w₁ w₂ w₃ with + | _ n IH => + have ⟨hw₁, hw₂, hw₃, hm₂, hm₃, hmom⟩ := hb + by_cases hM : mass N w₁ = 0 + · rw [hw₁.hat_eq_zero hM, hw₂.hat_eq_zero (hm₂.trans hM), hw₃.hat_eq_zero (hm₃.trans hM)] + exact compatible_zero + obtain ⟨⟨a₁, ha₁, hwa₁, hla₁⟩, ⟨b₁, hb₁, hwb₁, hlb₁⟩⟩ := hw₁.exists_le_moment_le hM + obtain ⟨⟨a₂, ha₂, hwa₂, hla₂⟩, ⟨b₂, hb₂, hwb₂, hlb₂⟩⟩ := + hw₂.exists_le_moment_le (by rwa [hm₂]) + obtain ⟨⟨a₃, ha₃, hwa₃, hla₃⟩, ⟨b₃, hb₃, hwb₃, hlb₃⟩⟩ := + hw₃.exists_le_moment_le (by rwa [hm₃]) + rw [hm₂] at hla₂ hlb₂ + rw [hm₃] at hla₃ hlb₃ + have hMpos : 0 < mass N w₁ := hw₁.mass_nonneg.lt_of_ne' hM + have hA : a₁ + a₂ + a₃ ≤ 2 * N := by + exact_mod_cast (by nlinarith : (a₁ + a₂ + a₃ : ℝ) ≤ 2 * N) + have hB : 2 * N ≤ b₁ + b₂ + b₃ := by + exact_mod_cast (by nlinarith : (2 * N : ℝ) ≤ b₁ + b₂ + b₃) + by_cases h₁ : 2 * N ≤ a₁ + a₂ + b₃ + · exact hb.compatible_hat_of_mix ih hn IH ha₁ ha₂ ha₃ hb₃ hwa₁ hwa₂ hwa₃ hwb₃ hA h₁ + by_cases h₂ : 2 * N ≤ a₁ + b₂ + b₃ + · exact (hb.comm₂₃.compatible_hat_of_mix ih (by grind) IH ha₁ hb₃ ha₂ hb₂ hwa₁ hwb₃ hwa₂ hwb₂ + (by grind) (by grind)).comm₂₃ + · exact (hb.comm₁₃.compatible_hat_of_mix ih (by grind) IH hb₃ hb₂ ha₁ hb₁ hwb₃ hwb₂ hwa₁ hwb₁ + (by grind) (by grind)).comm₁₃ + +/-- **Lemma 2.1 of Pebody, after applying `hat`.** The `hat` of a balanced triple of weights is +compatible, given Pebody's theorem at lower levels. -/ +lemma IsBalanced.compatible_hat (ih : ∀ m < N, DecreasingCompatible m) + (hb : IsBalanced N w₁ w₂ w₃) : Compatible N (hat N w₁) (hat N w₂) (hat N w₃) := + hb.compatible_hat_of_le ih _ le_rfl + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Decreasing.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Decreasing.lean new file mode 100644 index 0000000000..b6ded3322c --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Decreasing.lean @@ -0,0 +1,151 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Coupling.Basic +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Coupling.Decomposition +import Mathlib.Analysis.SpecialFunctions.Pow.Real + +/-! +# Pebody's theorem + +Three decreasing mass functions on `[0, N]` with equal masses whose means sum to `N` are compatible. +This is Theorem 4 of Pebody, *Proof of a conjecture of Kleinberg, Sawin and Speyer*. Kleinberg, +Sawin and Speyer apply it to the truncated geometric distribution with mean `N / 3`. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.geom N ρ`: the function `k ↦ ρ ^ k` on `[0, N]`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.compatible_of_isDecreasingOn`: Pebody's theorem. +* `ArithmeticTriangleRemovalInVectorSpaces.exists_compatible_geom`: for `N > 0` there is + `ρ ∈ [1 / 2, 1)` such that `geom N ρ` has mean `N / 3` and three copies of it are compatible. +-/ + +public section + +open Finset + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {N : ℕ} {π π₁ π₂ π₃ : ℕ → ℝ} + +private lemma IsDecreasingOn.isWeight (h : IsDecreasingOn N π) : + IsWeight N fun k ↦ (k + 1) * (π k - π (k + 1)) := + ⟨h.weight_nonneg, fun _ hk ↦ h.weight_eq_zero hk⟩ + +private lemma IsDecreasingOn.mass_eq (h : IsDecreasingOn N π) : + mass N π = mass N fun k ↦ (k + 1) * (π k - π (k + 1)) := by + nth_rw 1 [h.eq_hat] + exact mass_hat _ + +private lemma IsDecreasingOn.moment_eq (h : IsDecreasingOn N π) : + moment N π = moment N (fun k ↦ (k + 1) * (π k - π (k + 1))) / 2 := by + nth_rw 1 [h.eq_hat] + exact moment_hat _ + +/-- Pebody's theorem at every level. -/ +private lemma decreasingCompatible (N : ℕ) : DecreasingCompatible N := by + induction N using Nat.strong_induction_on with + | _ N ih => + intro π₁ π₂ π₃ h₁ h₂ h₃ hm₂ hm₃ hmom + rw [h₁.eq_hat, h₂.eq_hat, h₃.eq_hat] + refine IsBalanced.compatible_hat ih ⟨h₁.isWeight, h₂.isWeight, h₃.isWeight, ?_, ?_, ?_⟩ + · rw [← h₁.mass_eq, ← h₂.mass_eq, hm₂] + · rw [← h₁.mass_eq, ← h₃.mass_eq, hm₃] + · rw [← h₁.mass_eq] + linarith [h₁.moment_eq, h₂.moment_eq, h₃.moment_eq] + +/-- **Pebody's theorem.** Three decreasing mass functions on `[0, N]` with equal masses whose means +sum to `N` are compatible. -/ +private lemma compatible_of_isDecreasingOn (h₁ : IsDecreasingOn N π₁) (h₂ : IsDecreasingOn N π₂) + (h₃ : IsDecreasingOn N π₃) (hm₂ : mass N π₂ = mass N π₁) (hm₃ : mass N π₃ = mass N π₁) + (hmom : moment N π₁ + moment N π₂ + moment N π₃ = N * mass N π₁) : + Compatible N π₁ π₂ π₃ := + decreasingCompatible N π₁ π₂ π₃ h₁ h₂ h₃ hm₂ hm₃ hmom + +/-- The function `k ↦ ρ ^ k` on `[0, N]`, extended by zero. -/ +@[expose] noncomputable def geom (N : ℕ) (ρ : ℝ) (k : ℕ) : ℝ := + if k ≤ N then ρ ^ k else 0 + +private lemma mass_geom (ρ : ℝ) : mass N (geom N ρ) = ∑ k ∈ range (N + 1), ρ ^ k := by + rw [mass] + congr! 1 with k hk + simp [geom, Nat.le_of_lt_succ (mem_range.1 hk)] + +private lemma moment_geom (ρ : ℝ) : moment N (geom N ρ) = ∑ k ∈ range (N + 1), k * ρ ^ k := by + rw [moment] + congr! 1 with k hk + simp [geom, Nat.le_of_lt_succ (mem_range.1 hk)] + +private lemma isDecreasingOn_geom {ρ : ℝ} (hρ₀ : 0 ≤ ρ) (hρ₁ : ρ ≤ 1) : + IsDecreasingOn N (geom N ρ) := by + refine ⟨?_, ?_, by simp [geom]⟩ + · intro k + unfold geom + positivity + · intro a b hab + unfold geom + grind [pow_le_pow_of_le_one, pow_nonneg] + +/-- `∑ k ≤ M, (3 * k - N) / 2 ^ k = 6 - 2 * N - (3 * M + 6 - N) / 2 ^ M`. -/ +private lemma sum_mul_half_pow (N M : ℕ) : + ∑ k ∈ range (M + 1), (3 * k - N : ℝ) * (1 / 2) ^ k = 6 - 2 * N - (3 * M + 6 - N) / 2 ^ M := by + induction M with + | zero => + norm_num + ring + | succ M ih => + rw [sum_range_succ, ih, one_div_pow] + push_cast + field_simp + ring + +/-- For `N > 0`, the polynomial `∑ k ≤ N, (3 k - N) ρ ^ k` is nonpositive at `ρ = 1 / 2`. -/ +private lemma sum_mul_half_pow_nonpos (hN : 0 < N) : + ∑ k ∈ range (N + 1), (3 * k - N : ℝ) * (1 / 2) ^ k ≤ 0 := by + rw [sum_mul_half_pow] + obtain rfl | rfl | hN := (by grind : N = 1 ∨ N = 2 ∨ 3 ≤ N) + · norm_num + · norm_num + · have hN' : (3 : ℝ) ≤ N := by exact_mod_cast hN + linarith [div_nonneg (by linarith : (0 : ℝ) ≤ 3 * N + 6 - N) (by positivity : (0 : ℝ) ≤ 2 ^ N)] + +/-- The polynomial `∑ k ≤ N, (3 k - N) ρ ^ k` has a root in `[1 / 2, 1)`. -/ +private lemma exists_sum_mul_pow_eq_zero (hN : 0 < N) : + ∃ ρ : ℝ, 1 / 2 ≤ ρ ∧ ρ < 1 ∧ ∑ k ∈ range (N + 1), (3 * k - N) * ρ ^ k = 0 := by + set f : ℝ → ℝ := fun ρ ↦ ∑ k ∈ range (N + 1), (3 * k - N) * ρ ^ k + have hf₁ : f 1 = N * (N + 1) / 2 := by + simp only [f, one_pow, mul_one, sum_sub_distrib, ← mul_sum, sum_const, card_range, + nsmul_eq_mul, sum_range_succ_cast] + push_cast + ring + have hN' : (0 : ℝ) < N := by exact_mod_cast hN + obtain ⟨ρ, ⟨hρ₀, hρ₁⟩, hρ⟩ := intermediate_value_Icc (by norm_num : (1 / 2 : ℝ) ≤ 1) + (by fun_prop : Continuous f).continuousOn + (⟨sum_mul_half_pow_nonpos hN, by nlinarith⟩ : (0 : ℝ) ∈ Set.Icc (f (1 / 2)) (f 1)) + refine ⟨ρ, hρ₀, lt_of_le_of_ne hρ₁ ?_, hρ⟩ + rintro rfl + nlinarith + +/-- **The distribution of Kleinberg, Sawin and Speyer.** For `N > 0` there is `ρ ∈ [1 / 2, 1)` such +that `geom N ρ` has mean `N / 3` and three copies of it are compatible. -/ +lemma exists_compatible_geom (hN : 0 < N) : + ∃ ρ : ℝ, 1 / 2 ≤ ρ ∧ ρ < 1 ∧ + 3 * ∑ k ∈ range (N + 1), k * ρ ^ k = N * ∑ k ∈ range (N + 1), ρ ^ k ∧ + Compatible N (geom N ρ) (geom N ρ) (geom N ρ) := by + obtain ⟨ρ, hρ₀, hρ₁, hρ⟩ := exists_sum_mul_pow_eq_zero hN + have hmean : 3 * ∑ k ∈ range (N + 1), k * ρ ^ k = N * ∑ k ∈ range (N + 1), ρ ^ k := by + simp only [sub_mul, sum_sub_distrib, mul_assoc, ← mul_sum] at hρ + linarith + have hd := isDecreasingOn_geom (N := N) (by linarith) hρ₁.le + refine ⟨ρ, hρ₀, hρ₁, hmean, compatible_of_isDecreasingOn hd hd hd rfl rfl ?_⟩ + rw [moment_geom, mass_geom] + linarith + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Peeling.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Peeling.lean new file mode 100644 index 0000000000..d02d3b2e9d --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Peeling.lean @@ -0,0 +1,351 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Coupling.Basic +import Mathlib.Analysis.SpecialFunctions.Pow.Real + +/-! +# Peeling off the layer where the first variable vanishes + +This file contains the induction step of Pebody's proof that decreasing mass functions on `[0, N]` +whose means sum to `N` are compatible. If the second and the third mass functions vanish at `N`, +then the mass of the first one at `0` can be matched with pairs `(k, N - k)` so that what remains is +again decreasing, at level `N - 1`. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.IsDecreasingOn N π`: `π` is a nonnegative, antitone mass + function vanishing beyond `N`. +* `ArithmeticTriangleRemovalInVectorSpaces.mass N π` and + `ArithmeticTriangleRemovalInVectorSpaces.moment N π`: the total mass and the first moment. +* `ArithmeticTriangleRemovalInVectorSpaces.DecreasingCompatible N`: the statement of Pebody's + theorem at level `N`. +* `ArithmeticTriangleRemovalInVectorSpaces.peelWeight N π₂ π₃ x`: the overlap of `π₂` and the + reflection of `π₃`, cut at height `x`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.le_sum_min`: Lemma 3.1 of Pebody. +* `ArithmeticTriangleRemovalInVectorSpaces.compatible_of_eq_zero_of_eq_zero`: Corollary 3.2 of + Pebody. +-/ + +public section + +open Finset + +namespace ArithmeticTriangleRemovalInVectorSpaces + +/-- A mass function on `ℕ` is decreasing on `[0, N]` if it is nonnegative, antitone and vanishes at +`N + 1`. -/ +@[expose] def IsDecreasingOn (N : ℕ) (π : ℕ → ℝ) : Prop := + (∀ k, 0 ≤ π k) ∧ Antitone π ∧ π (N + 1) = 0 + +/-- The total mass of `π` on `[0, N]`. -/ +@[expose] def mass (N : ℕ) (π : ℕ → ℝ) : ℝ := + ∑ k ∈ range (N + 1), π k + +/-- The first moment of `π` on `[0, N]`. -/ +@[expose] def moment (N : ℕ) (π : ℕ → ℝ) : ℝ := + ∑ k ∈ range (N + 1), k * π k + +/-- Pebody's theorem at level `N`: decreasing mass functions on `[0, N]` with equal masses whose +means sum to `N` are compatible. -/ +@[expose] def DecreasingCompatible (N : ℕ) : Prop := + ∀ π₁ π₂ π₃ : ℕ → ℝ, IsDecreasingOn N π₁ → IsDecreasingOn N π₂ → IsDecreasingOn N π₃ → + mass N π₂ = mass N π₁ → mass N π₃ = mass N π₁ → + moment N π₁ + moment N π₂ + moment N π₃ = N * mass N π₁ → Compatible N π₁ π₂ π₃ + +variable {N : ℕ} {π π' π₁ π₂ π₃ : ℕ → ℝ} + +lemma mass_add : mass N (π + π') = mass N π + mass N π' := by + simp [mass, sum_add_distrib] + +lemma mass_sub : mass N (π - π') = mass N π - mass N π' := by + simp [mass, sum_sub_distrib] + +lemma mass_smul (r : ℝ) : mass N (r • π) = r * mass N π := by + simp [mass, mul_sum] + +lemma moment_add : moment N (π + π') = moment N π + moment N π' := by + simp [moment, mul_add, sum_add_distrib] + +lemma moment_sub : moment N (π - π') = moment N π - moment N π' := by + simp [moment, mul_sub, sum_sub_distrib] + +lemma moment_smul (r : ℝ) : moment N (r • π) = r * moment N π := by + simp only [moment, Pi.smul_apply, smul_eq_mul, mul_sum] + congr with k + ring + +private lemma mass_succ : mass (N + 1) π = mass N π + π (N + 1) := + sum_range_succ _ _ + +private lemma moment_succ : moment (N + 1) π = moment N π + (N + 1) * π (N + 1) := by + rw [moment, sum_range_succ, ← moment] + push_cast + ring + +private lemma mass_shift : mass N (fun k ↦ π (k + 1)) = mass (N + 1) π - π 0 := by + rw [mass, mass, sum_range_succ' _ (N + 1)] + ring + +private lemma moment_shift : + moment N (fun k ↦ π (k + 1)) = moment (N + 1) π - mass (N + 1) π + π 0 := by + rw [moment, moment, mass, sum_range_succ' _ (N + 1), sum_range_succ' _ (N + 1)] + push_cast + simp only [add_mul, one_mul, sum_add_distrib] + ring + +private lemma mass_reflect : mass N (fun k ↦ π (N - k)) = mass N π := by + simpa [mass] using sum_range_reflect π (N + 1) + +private lemma moment_reflect : moment N (fun k ↦ π (N - k)) = N * mass N π - moment N π := by + rw [moment, ← sum_range_reflect, mass, moment, mul_sum, ← sum_sub_distrib] + congr! 1 with k hk + rw [mem_range] at hk + rw [Nat.add_sub_cancel, Nat.sub_sub_self (by grind), Nat.cast_sub (by grind)] + ring + +lemma IsDecreasingOn.eq_zero_of_lt (h : IsDecreasingOn N π) {k : ℕ} (hk : N < k) : π k = 0 := by + obtain ⟨hπ₀, hπ, hπN⟩ := h + exact le_antisymm (hπN ▸ hπ hk) (hπ₀ k) + +private lemma IsDecreasingOn.le_mass (h : IsDecreasingOn N π) (k : ℕ) : π k ≤ mass N π := by + have ⟨hπ₀, _, _⟩ := h + by_cases hk : k ≤ N + · refine single_le_sum ?_ (mem_range.2 (by grind)) + intro i _ + exact hπ₀ i + · rw [h.eq_zero_of_lt (by grind)] + apply sum_nonneg + intro i _ + exact hπ₀ i + +private lemma IsDecreasingOn.of_succ (h : IsDecreasingOn (N + 1) π) (hN : π (N + 1) = 0) : + IsDecreasingOn N π := by + obtain ⟨hπ₀, hπ, -⟩ := h + exact ⟨hπ₀, hπ, hN⟩ + +/-- The first mass function after peeling: `π` shifted down by one. -/ +lemma IsDecreasingOn.shift (h : IsDecreasingOn (N + 1) π) : + IsDecreasingOn N fun k ↦ π (k + 1) := by + obtain ⟨hπ₀, hπ, hπN⟩ := h + exact ⟨fun k ↦ hπ₀ _, fun _ _ hab ↦ hπ (by grind), hπN⟩ + +/-- Decreasing weights on `[s, e]` have mean at most `(s + e) / 2`. -/ +private lemma two_mul_sum_Icc_le (hπ : Antitone π) (s e : ℕ) : + 2 * ∑ k ∈ Icc s e, (k : ℝ) * π k ≤ (s + e) * ∑ k ∈ Icc s e, π k := by + have hrefl : ∑ k ∈ Icc s e, (s + e - 2 * k : ℝ) * π k = + ∑ k ∈ Icc s e, (2 * k - (s + e) : ℝ) * π (s + e - k) := by + refine sum_nbij' (fun k ↦ s + e - k) (fun k ↦ s + e - k) ?_ ?_ ?_ ?_ ?_ + any_goals intro k hk; simp only [mem_Icc] at hk ⊢; grind + intro k hk + rw [mem_Icc] at hk + rw [Nat.sub_sub_self (by grind), Nat.cast_sub (by grind)] + push_cast + ring + have hterm (k) (_ : k ∈ Icc s e) : (2 * k - (s + e) : ℝ) * (π k - π (s + e - k)) ≤ 0 := by + rcases le_total (2 * k) (s + e) with h | h + · exact mul_nonpos_of_nonpos_of_nonneg (sub_nonpos.2 (by exact_mod_cast h)) + (sub_nonneg.2 (hπ (by grind))) + · exact mul_nonpos_of_nonneg_of_nonpos (sub_nonneg.2 (by exact_mod_cast h)) + (sub_nonpos.2 (hπ (by grind))) + have hsum := sum_nonpos hterm + simp only [mul_sub, sub_mul, sum_sub_distrib, mul_assoc, ← mul_sum] at hrefl hsum + linarith + +/-- For a decreasing mass function `π` on `[0, N]` and `t ≤ N`, the bound +`2 * moment N π ≤ t * mass N π + (N + 1) * (mass N π - ∑ k ∈ range (t + 1), π k)`. -/ +private lemma IsDecreasingOn.two_mul_moment_le (h : IsDecreasingOn N π) {t : ℕ} (ht : t ≤ N) : + 2 * moment N π ≤ t * mass N π + (N + 1) * (mass N π - ∑ k ∈ range (t + 1), π k) := by + obtain ⟨-, hπ, -⟩ := h + have h₁ := two_mul_sum_Icc_le hπ 0 t + have h₂ := two_mul_sum_Icc_le hπ (t + 1) N + rw [← Ico_add_one_right_eq_Icc, ← range_eq_Ico] at h₁ + rw [← Ico_add_one_right_eq_Icc, sum_Ico_eq_sub _ (by grind), sum_Ico_eq_sub _ (by grind)] at h₂ + rw [moment, mass] + push_cast at h₁ h₂ + linarith + +/-- **Lemma 3.1 of Pebody**, for a cut after `t + 1 ≤ N` terms. -/ +private lemma le_sum_range_add_sum_Ico (h₁ : IsDecreasingOn N π₁) (h₂ : IsDecreasingOn N π₂) + (h₃ : IsDecreasingOn N π₃) (hm₂ : mass N π₂ = mass N π₁) (hm₃ : mass N π₃ = mass N π₁) + (hmom : moment N π₁ + moment N π₂ + moment N π₃ = N * mass N π₁) {t : ℕ} (ht : t + 1 ≤ N) : + π₁ 0 ≤ ∑ k ∈ range (t + 1), π₃ (N - k) + ∑ k ∈ Ico (t + 1) (N + 1), π₂ k := by + have e₁ := h₁.two_mul_moment_le (Nat.zero_le N) + have e₂ := h₂.two_mul_moment_le (by grind : t ≤ N) + have e₃ := h₃.two_mul_moment_le (t := N - 1 - t) (by grind) + rw [zero_add, sum_range_one, Nat.cast_zero, zero_mul, zero_add] at e₁ + rw [(by grind : N - 1 - t + 1 = N - t), Nat.cast_sub (by grind), Nat.cast_sub (by grind)] at e₃ + rw [range_eq_Ico, sum_Ico_reflect _ _ (by grind), Nat.add_sub_add_right, Nat.sub_zero, + sum_Ico_eq_sub _ (by grind), sum_Ico_eq_sub _ (by grind), ← mass, ← mass] + refine le_of_mul_le_mul_left ?_ (by positivity : (0 : ℝ) < N + 1) + push_cast at e₃ + nlinarith + +/-- If `a` is antitone and `b` is monotone, then `∑ k ∈ range n, min (a k) (b k)` splits at the +first point where `b` exceeds `a`. -/ +private lemma exists_sum_min_eq {a b : ℕ → ℝ} (ha : Antitone a) (hb : Monotone b) (n : ℕ) : + ∃ t ≤ n, ∑ k ∈ range n, min (a k) (b k) = ∑ k ∈ range t, b k + ∑ k ∈ Ico t n, a k := by + classical + have hex : ∃ t, n ≤ t ∨ a t < b t := ⟨n, .inl le_rfl⟩ + have ht := Nat.find_min' hex (.inl le_rfl) + refine ⟨Nat.find hex, ht, ?_⟩ + rw [← sum_range_add_sum_Ico _ ht] + congr 1 + · congr! 1 with k hk + have := Nat.find_min hex (mem_range.1 hk) + exact min_eq_right (by grind) + · congr! 1 with k hk + rw [mem_Ico] at hk + obtain ⟨hk₁, hk₂⟩ := hk + rcases Nat.find_spec hex with h | h + · grind + · exact min_eq_left ((ha hk₁).trans (h.le.trans (hb hk₁))) + +/-- **Lemma 3.1 of Pebody.** The mass of `π₁` at `0` is at most the overlap +`∑ k ∈ range (N + 1), min (π₂ k) (π₃ (N - k))`. -/ +private lemma le_sum_min (h₁ : IsDecreasingOn N π₁) (h₂ : IsDecreasingOn N π₂) + (h₃ : IsDecreasingOn N π₃) (hm₂ : mass N π₂ = mass N π₁) (hm₃ : mass N π₃ = mass N π₁) + (hmom : moment N π₁ + moment N π₂ + moment N π₃ = N * mass N π₁) : + π₁ 0 ≤ ∑ k ∈ range (N + 1), min (π₂ k) (π₃ (N - k)) := by + have ⟨_, hπ₂, _⟩ := h₂ + have ⟨_, hπ₃, _⟩ := h₃ + obtain ⟨t, ht, heq⟩ := + exists_sum_min_eq (b := fun k ↦ π₃ (N - k)) hπ₂ (hπ₃.comp antitone_const_tsub) (N + 1) + rw [heq] + rcases Nat.eq_zero_or_pos t with rfl | ht₀ + · rw [range_zero, sum_empty, zero_add, ← range_eq_Ico, ← mass, hm₂] + exact h₁.le_mass 0 + obtain rfl | htN := ht.eq_or_lt + · rw [Ico_self, sum_empty, add_zero] + exact (h₁.le_mass 0).trans_eq (mass_reflect.trans hm₃).symm + obtain ⟨s, rfl⟩ : ∃ s, t = s + 1 := ⟨t - 1, by grind⟩ + exact le_sum_range_add_sum_Ico h₁ h₂ h₃ hm₂ hm₃ hmom (by grind) + +/-- The overlap of `π₂` and the reflection of `π₃`, cut at height `x`. Peeling it off removes the +layer where the first variable vanishes. -/ +private noncomputable def peelWeight (N : ℕ) (π₂ π₃ : ℕ → ℝ) (x : ℝ) (k : ℕ) : ℝ := + min (min (π₂ k) (π₃ (N - k))) x + +private lemma continuous_mass_peelWeight (N : ℕ) (π₂ π₃ : ℕ → ℝ) : + Continuous fun x ↦ mass N (peelWeight N π₂ π₃ x) := by + unfold mass peelWeight + fun_prop + +/-- There is a height `x ≥ 0` at which the overlap of `π₂` and `π₃` has mass `π₁ 0`. -/ +private lemma exists_mass_peelWeight_eq (h₁ : IsDecreasingOn N π₁) (h₂ : IsDecreasingOn N π₂) + (h₃ : IsDecreasingOn N π₃) (hm₂ : mass N π₂ = mass N π₁) (hm₃ : mass N π₃ = mass N π₁) + (hmom : moment N π₁ + moment N π₂ + moment N π₃ = N * mass N π₁) : + ∃ x, 0 ≤ x ∧ mass N (peelWeight N π₂ π₃ x) = π₁ 0 := by + have ⟨hπ₁, _, _⟩ := h₁ + have ⟨hπ₂, _, _⟩ := h₂ + have ⟨hπ₃, _, _⟩ := h₃ + have h0 : mass N (peelWeight N π₂ π₃ 0) = 0 := by + apply sum_eq_zero + intro k _ + exact min_eq_right (le_min (hπ₂ k) (hπ₃ _)) + have hM : mass N (peelWeight N π₂ π₃ (mass N π₁)) = + ∑ k ∈ range (N + 1), min (π₂ k) (π₃ (N - k)) := by + congr with k + exact min_eq_left ((min_le_left _ _).trans (hm₂ ▸ h₂.le_mass k)) + obtain ⟨x, ⟨hx, -⟩, hxeq⟩ := intermediate_value_Icc ((hπ₁ 0).trans (h₁.le_mass 0)) + (continuous_mass_peelWeight N π₂ π₃).continuousOn + ⟨h0 ▸ hπ₁ 0, hM ▸ le_sum_min h₁ h₂ h₃ hm₂ hm₃ hmom⟩ + exact ⟨x, hx, hxeq⟩ + +section Peel + +variable {n : ℕ} {x : ℝ} (hx : 0 ≤ x) (h₂ : IsDecreasingOn n π₂) (h₃ : IsDecreasingOn n π₃) +include hx h₂ h₃ + +private lemma peelWeight_nonneg (k : ℕ) : 0 ≤ peelWeight (n + 1) π₂ π₃ x k := by + obtain ⟨hπ₂, -, -⟩ := h₂ + obtain ⟨hπ₃, -, -⟩ := h₃ + exact le_min (le_min (hπ₂ k) (hπ₃ _)) hx + +private lemma peelWeight_eq_zero_of_lt {k : ℕ} (hk : n < k) : peelWeight (n + 1) π₂ π₃ x k = 0 := by + refine le_antisymm ?_ (peelWeight_nonneg hx h₂ h₃ k) + exact ((min_le_left _ _).trans (min_le_left _ _)).trans (h₂.eq_zero_of_lt hk).le + +private lemma peelWeight_zero : peelWeight (n + 1) π₂ π₃ x 0 = 0 := by + refine le_antisymm ?_ (peelWeight_nonneg hx h₂ h₃ 0) + exact ((min_le_left _ _).trans (min_le_right _ _)).trans (h₃.eq_zero_of_lt (by grind)).le + +private lemma isDecreasingOn_sub_peelWeight : + IsDecreasingOn n (π₂ - peelWeight (n + 1) π₂ π₃ x) := by + have hN := peelWeight_eq_zero_of_lt hx h₂ h₃ (Nat.lt_succ_self n) + obtain ⟨hπ₂₀, hπ₂, hπ₂N⟩ := h₂ + obtain ⟨-, hπ₃, -⟩ := h₃ + refine ⟨fun k ↦ sub_nonneg.2 ((min_le_left _ _).trans (min_le_left _ _)), ?_, by simp [hπ₂N, hN]⟩ + apply antitone_nat_of_succ_le + intro k + simp only [Pi.sub_apply, peelWeight] + grind [hπ₂ (Nat.le_succ k), hπ₃ (by grind : n + 1 - (k + 1) ≤ n + 1 - k)] + +private lemma isDecreasingOn_sub_peelWeight_reflect : + IsDecreasingOn n (π₃ - fun c ↦ peelWeight (n + 1) π₂ π₃ x (n + 1 - c)) := by + have h₀ := peelWeight_zero hx h₂ h₃ + obtain ⟨hπ₂₀, hπ₂, hπ₂N⟩ := h₂ + obtain ⟨hπ₃₀, hπ₃, hπ₃N⟩ := h₃ + have hle (c : ℕ) : peelWeight (n + 1) π₂ π₃ x (n + 1 - c) ≤ π₃ c := by + by_cases hc : c ≤ n + 1 + · rw [peelWeight, Nat.sub_sub_self hc] + grw [min_le_left, min_le_right] + · rw [(by grind : n + 1 - c = 0), h₀] + exact hπ₃₀ c + refine ⟨fun c ↦ sub_nonneg.2 (hle c), ?_, by simp [hπ₃N, h₀]⟩ + apply antitone_nat_of_succ_le + intro c + simp only [Pi.sub_apply, peelWeight] + grind [hπ₃ (Nat.le_succ c), hπ₂ (by grind : n + 1 - (c + 1) ≤ n + 1 - c)] + +end Peel + +/-- **Corollary 3.2 of Pebody.** If Pebody's theorem holds at level `n`, then decreasing mass +functions at level `n + 1` whose second and third members vanish at `n + 1` are compatible. -/ +lemma compatible_of_eq_zero_of_eq_zero {n : ℕ} (ih : DecreasingCompatible n) + (h₁ : IsDecreasingOn (n + 1) π₁) (h₂ : IsDecreasingOn (n + 1) π₂) + (h₃ : IsDecreasingOn (n + 1) π₃) (h₂N : π₂ (n + 1) = 0) (h₃N : π₃ (n + 1) = 0) + (hm₂ : mass (n + 1) π₂ = mass (n + 1) π₁) (hm₃ : mass (n + 1) π₃ = mass (n + 1) π₁) + (hmom : moment (n + 1) π₁ + moment (n + 1) π₂ + moment (n + 1) π₃ = + (n + 1 : ℕ) * mass (n + 1) π₁) : + Compatible (n + 1) π₁ π₂ π₃ := by + obtain ⟨x, hx, hsum⟩ := exists_mass_peelWeight_eq h₁ h₂ h₃ hm₂ hm₃ hmom + replace h₂ := h₂.of_succ h₂N + replace h₃ := h₃.of_succ h₃N + have hf₀ := peelWeight_zero hx h₂ h₃ + have hfN := peelWeight_eq_zero_of_lt hx h₂ h₃ (Nat.lt_succ_self n) + have hcomp := ih _ _ _ h₁.shift (isDecreasingOn_sub_peelWeight hx h₂ h₃) + (isDecreasingOn_sub_peelWeight_reflect hx h₂ h₃) ?_ ?_ ?_ + · convert (hcomp.comm₁₃.shift 1).comm₁₃.add (compatible_layer (peelWeight_nonneg hx h₂ h₃)) + using 1 + · ext a + rcases Nat.eq_zero_or_pos a with rfl | ha + · simpa [mass] using hsum.symm + · simp [(by grind : 1 ≤ a), (by grind : a ≠ 0), Nat.sub_add_cancel ha] + · ext b + by_cases hb : b ≤ n + 1 + · simp [hb] + · simp [hb, peelWeight_eq_zero_of_lt hx h₂ h₃ (by grind : n < b)] + · ext c + by_cases hc : c ≤ n + 1 + · simp [hc] + · simp [hc, (by grind : n + 1 - c = 0), hf₀] + · rw [mass_sub, mass_shift, ← hm₂, ← hsum] + simp [mass_succ, h₂N, hfN] + · rw [mass_sub, mass_shift, ← hm₃, ← hsum, ← mass_reflect (π := peelWeight (n + 1) π₂ π₃ x)] + simp [mass_succ, h₃N, hf₀] + · have hrefl := moment_reflect (N := n + 1) (π := peelWeight (n + 1) π₂ π₃ x) + rw [moment_succ, Nat.sub_self, hf₀, mul_zero, add_zero] at hrefl + rw [moment_shift, mass_shift, moment_sub, moment_sub, hrefl, hsum] + simp only [moment_succ, h₂N, h₃N, hfN, mul_zero, add_zero] at hmom ⊢ + push_cast at hmom ⊢ + linarith + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Uniform.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Uniform.lean new file mode 100644 index 0000000000..d7e9c49629 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Coupling/Uniform.lean @@ -0,0 +1,334 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Coupling.Peeling +import Mathlib.Analysis.SpecialFunctions.Pow.Real + +/-! +# Uniform distributions and their mixtures + +Every decreasing mass function on `[0, N]` is a nonnegative combination of the uniform distributions +`unif k` on `[0, k]`, `k ≤ N`. This file proves that `unif k₁`, `unif k₂` and a mixture of `unif y` +and `unif z` are compatible when their means sum to `N`, assuming Pebody's theorem at lower levels. +This is the case analysis of Section 5 of Pebody. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.unif k`: the uniform distribution on `[0, k]`. +* `ArithmeticTriangleRemovalInVectorSpaces.hat N w`: the combination + `∑ k ∈ range (N + 1), w k • unif k`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.IsDecreasingOn.eq_hat`: a decreasing mass function is a + nonnegative combination of uniform distributions. +* `ArithmeticTriangleRemovalInVectorSpaces.compatible_lastcase`: Corollary 5.2 of Pebody. +* `ArithmeticTriangleRemovalInVectorSpaces.compatible_unif_mix`: `unif k₁`, `unif k₂` and + `α • unif y + (1 - α) • unif z` are compatible when their means sum to `N`. +-/ + +public section + +open Finset + +namespace ArithmeticTriangleRemovalInVectorSpaces + +/-- The uniform distribution on `[0, k]`. -/ +@[expose] noncomputable def unif (k j : ℕ) : ℝ := + if j ≤ k then ((k : ℝ) + 1)⁻¹ else 0 + +/-- The combination `∑ k ∈ range (N + 1), w k • unif k` of uniform distributions. -/ +@[expose] noncomputable def hat (N : ℕ) (w : ℕ → ℝ) (j : ℕ) : ℝ := + ∑ k ∈ range (N + 1), w k * unif k j + +variable {N k : ℕ} {π π' π₁ π₂ π₃ : ℕ → ℝ} + +lemma IsDecreasingOn.add (h : IsDecreasingOn N π) (h' : IsDecreasingOn N π') : + IsDecreasingOn N (π + π') := by + obtain ⟨hπ₀, hπ, hπN⟩ := h + obtain ⟨hπ₀', hπ', hπN'⟩ := h' + exact ⟨fun k ↦ add_nonneg (hπ₀ k) (hπ₀' k), hπ.add hπ', by simp [hπN, hπN']⟩ + +lemma IsDecreasingOn.smul (h : IsDecreasingOn N π) {r : ℝ} (hr : 0 ≤ r) : + IsDecreasingOn N (r • π) := by + obtain ⟨hπ₀, hπ, hπN⟩ := h + exact ⟨fun k ↦ mul_nonneg hr (hπ₀ k), fun _ _ hab ↦ mul_le_mul_of_nonneg_left (hπ hab) hr, + by simp [hπN]⟩ + +private lemma isDecreasingOn_unif (hk : k ≤ N) : IsDecreasingOn N (unif k) := by + refine ⟨?_, ?_, ?_⟩ + · intro j + unfold unif + positivity + · intro a b hab + unfold unif + grind [(by positivity : (0 : ℝ) ≤ ((k : ℝ) + 1)⁻¹)] + · simp only [unif, ite_eq_right_iff] + grind + +private lemma unif_eq_zero (hk : k < N) : unif k N = 0 := by + simp only [unif, ite_eq_right_iff] + grind + +private lemma sum_mul_unif (hk : k ≤ N) (f : ℕ → ℝ) : + ∑ j ∈ range (N + 1), f j * unif k j = (∑ j ∈ range (k + 1), f j) / (k + 1) := by + rw [← sum_range_add_sum_Ico _ (by grind : k + 1 ≤ N + 1), sum_eq_zero (s := Ico _ _), + add_zero, div_eq_mul_inv, sum_mul] + · rw [← Fin.sum_univ_eq_sum_range, ← Fin.sum_univ_eq_sum_range] + congr with j + simp [unif, j.is_le] + · intro j hj + simp only [mem_Ico] at hj + simp [unif, (by grind : ¬j ≤ k)] + +private lemma mass_unif (hk : k ≤ N) : mass N (unif k) = 1 := by + have h := sum_mul_unif hk fun _ ↦ 1 + simp only [one_mul, sum_const, card_range, nsmul_eq_mul, mul_one] at h + rw [mass, h] + push_cast + field_simp + +lemma sum_range_succ_cast (k : ℕ) : ∑ j ∈ range (k + 1), (j : ℝ) = k * (k + 1) / 2 := by + induction k with + | zero => simp + | succ k ih => + rw [sum_range_succ, ih] + push_cast + ring + +private lemma moment_unif (hk : k ≤ N) : moment N (unif k) = k / 2 := by + rw [moment, sum_mul_unif hk, sum_range_succ_cast] + field_simp + +private lemma isDecreasingOn_mix {y z : ℕ} (hy : y ≤ N) (hz : z ≤ N) {α : ℝ} (hα₀ : 0 ≤ α) + (hα₁ : α ≤ 1) : IsDecreasingOn N (α • unif y + (1 - α) • unif z) := + ((isDecreasingOn_unif hy).smul hα₀).add ((isDecreasingOn_unif hz).smul (by linarith)) + +private lemma mass_mix {y z : ℕ} (hy : y ≤ N) (hz : z ≤ N) (α : ℝ) : + mass N (α • unif y + (1 - α) • unif z) = 1 := by + rw [mass_add, mass_smul, mass_smul, mass_unif hy, mass_unif hz] + ring + +private lemma moment_mix {y z : ℕ} (hy : y ≤ N) (hz : z ≤ N) (α : ℝ) : + moment N (α • unif y + (1 - α) • unif z) = (α * y + (1 - α) * z) / 2 := by + rw [moment_add, moment_smul, moment_smul, moment_unif hy, moment_unif hz] + ring + +private lemma mix_eq_zero {y z : ℕ} {α : ℝ} (hy : y < N ∨ α = 0) (hz : z < N ∨ α = 1) : + (α • unif y + (1 - α) • unif z) N = 0 := by + rcases hy with hy | rfl <;> rcases hz with hz | hz <;> simp_all [unif_eq_zero] + +/-- A mixture of uniform distributions with mean `0` is the point mass at `0`. -/ +private lemma mix_eq_unif_zero {y z : ℕ} {α : ℝ} (hα₀ : 0 ≤ α) (hα₁ : α ≤ 1) + (h : α * y + (1 - α) * z = 0) : α • unif y + (1 - α) • unif z = unif 0 := by + obtain ⟨hy, hz⟩ := (add_eq_zero_iff_of_nonneg (by positivity) + (mul_nonneg (sub_nonneg.2 hα₁) z.cast_nonneg)).1 h + rcases mul_eq_zero.1 hy with rfl | hy <;> rcases mul_eq_zero.1 hz with hz | hz + · norm_num at hz + · simp_all + · rw [(by linarith : α = 1)] + simp_all + · simp_all [← add_smul] + +lemma hat_add (w w' : ℕ → ℝ) : hat N (w + w') = hat N w + hat N w' := by + ext j + simp [hat, add_mul, sum_add_distrib] + +lemma hat_smul (r : ℝ) (w : ℕ → ℝ) : hat N (r • w) = r • hat N w := by + ext j + simp [hat, mul_sum, mul_assoc] + +private lemma hat_zero : hat N 0 = 0 := by + ext j + simp [hat] + +lemma hat_single (hk : k ≤ N) : hat N (Pi.single k 1) = unif k := by + ext j + rw [hat, sum_eq_single_of_mem k (mem_range.2 (by grind)) fun b _ hb ↦ by simp [hb]] + simp + +lemma mass_hat (w : ℕ → ℝ) : mass N (hat N w) = ∑ k ∈ range (N + 1), w k := by + simp only [mass, hat] + rw [sum_comm, ← Fin.sum_univ_eq_sum_range, ← Fin.sum_univ_eq_sum_range] + congr with k + rw [← mul_sum, ← mass, mass_unif k.is_le, mul_one] + +lemma moment_hat (w : ℕ → ℝ) : + moment N (hat N w) = (∑ k ∈ range (N + 1), (k : ℝ) * w k) / 2 := by + simp only [moment, hat, mul_sum] + rw [sum_comm, div_eq_mul_inv, sum_mul, ← Fin.sum_univ_eq_sum_range, + ← Fin.sum_univ_eq_sum_range] + congr with k + simp_rw [mul_left_comm _ (w k), ← mul_sum] + rw [← moment, moment_unif k.is_le] + ring + +/-- **A decreasing mass function is a combination of uniform distributions**, with the nonnegative +weights `(k + 1) * (π k - π (k + 1))`. -/ +lemma IsDecreasingOn.eq_hat (h : IsDecreasingOn N π) : + π = hat N fun k ↦ (k + 1) * (π k - π (k + 1)) := by + ext j + have hterm (k : ℕ) : (k + 1 : ℝ) * (π k - π (k + 1)) * unif k j = + if j ≤ k then π k - π (k + 1) else 0 := by + unfold unif + grind + simp only [hat, hterm] + by_cases hj : j ≤ N + · rw [← sum_range_add_sum_Ico _ (by grind : j ≤ N + 1), sum_eq_zero fun k hk ↦ by grind, + zero_add, sum_Ico_eq_sum_range] + simp only [le_add_iff_nonneg_right, zero_le, ite_true, add_assoc j] + rw [sum_range_sub' (fun k ↦ π (j + k)), add_zero, (by grind : j + (N + 1 - j) = N + 1), + h.eq_zero_of_lt (Nat.lt_succ_self N), sub_zero] + · rw [h.eq_zero_of_lt (by grind)] + symm + apply sum_eq_zero + grind + +lemma IsDecreasingOn.weight_nonneg (h : IsDecreasingOn N π) (k : ℕ) : + 0 ≤ (k + 1 : ℝ) * (π k - π (k + 1)) := by + obtain ⟨-, hπ, -⟩ := h + exact mul_nonneg (by positivity) (sub_nonneg.2 (hπ (Nat.le_succ k))) + +lemma IsDecreasingOn.weight_eq_zero (h : IsDecreasingOn N π) {k : ℕ} (hk : N < k) : + (k + 1 : ℝ) * (π k - π (k + 1)) = 0 := by + rw [h.eq_zero_of_lt hk, h.eq_zero_of_lt (by grind), sub_zero, mul_zero] + +/-- The triples `(0, b, N - b)` with `b` uniform on `[0, N]`. -/ +private lemma compatible_unif_zero : Compatible N (unif 0) (unif N) (unif N) := by + convert compatible_layer (N := N) (f := fun _ ↦ ((N : ℝ) + 1)⁻¹) (fun _ ↦ by positivity) + using 1 + · ext a + simp only [unif, nonpos_iff_eq_zero, CharP.cast_eq_zero, zero_add, inv_one, sum_const, + card_range, nsmul_eq_mul] + push_cast + grind + · ext b + rfl + · ext c + rfl + +/-- Three uniform distributions whose means sum to the level `a + b` are compatible, given Pebody's +theorem at that level. -/ +private lemma compatible_unif_triple {a b : ℕ} (h : DecreasingCompatible (a + b)) : + Compatible (a + b) (unif a) (unif b) (unif (a + b)) := by + refine h _ _ _ (isDecreasingOn_unif (by grind)) (isDecreasingOn_unif (by grind)) + (isDecreasingOn_unif le_rfl) ?_ ?_ ?_ + · rw [mass_unif (by grind), mass_unif (by grind)] + · rw [mass_unif le_rfl, mass_unif (by grind)] + · rw [moment_unif (by grind), moment_unif (by grind), moment_unif le_rfl, mass_unif (by grind)] + push_cast + ring + +/-- **Corollary 3.2 of Pebody** for three mass functions of mass one. -/ +private lemma compatible_of_eq_zero_of_eq_zero_of_mass_eq_one (ih : ∀ m < N, DecreasingCompatible m) + (hN : N ≠ 0) (h₁ : IsDecreasingOn N π₁) (h₂ : IsDecreasingOn N π₂) (h₃ : IsDecreasingOn N π₃) + (h₂N : π₂ N = 0) (h₃N : π₃ N = 0) (hm₁ : mass N π₁ = 1) (hm₂ : mass N π₂ = 1) + (hm₃ : mass N π₃ = 1) (hmom : moment N π₁ + moment N π₂ + moment N π₃ = N) : + Compatible N π₁ π₂ π₃ := by + obtain ⟨n, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hN + refine compatible_of_eq_zero_of_eq_zero (ih n (by grind)) h₁ h₂ h₃ h₂N h₃N + (hm₂.trans hm₁.symm) (hm₃.trans hm₁.symm) ?_ + rw [hm₁, mul_one, hmom] + +/-- **Corollary 5.2 of Pebody.** For `i > 0`, the distributions `unif i`, `unif N` and the mixture +of `unif j` and `unif N` with mean `(N - i) / 2` are compatible, where `N = i + j + r + 1`. -/ +private lemma compatible_lastcase {i j r : ℕ} (hij : DecreasingCompatible (i + j)) + (hir : DecreasingCompatible (i + r)) : + Compatible (i + j + r + 1) (unif i) (unif (i + j + r + 1)) + (((i : ℝ) / (i + r + 1)) • unif j + (1 - (i : ℝ) / (i + r + 1)) • unif (i + j + r + 1)) := by + have hw₁ : (0 : ℝ) ≤ 1 - (i + j + 1) / (i + j + r + 2) := by + rw [sub_nonneg, div_le_one (by positivity)] + linarith + have h₁ := ((compatible_unif_triple hij).shift (r + 1)).comm₂₃.smul + (by positivity : (0 : ℝ) ≤ (i + j + 1) / (i + j + r + 2)) + have h₂ := ((compatible_unif_triple hir).shift (j + 1)).smul hw₁ + rw [(by grind : i + r + (j + 1) = i + j + (r + 1))] at h₂ + rw [(by grind : i + j + r + 1 = i + j + (r + 1))] + convert h₁.add h₂ using 1 + · ext k + simp only [Pi.add_apply, Pi.smul_apply, smul_eq_mul] + ring + · ext k + simp only [unif, Pi.add_apply, Pi.smul_apply, smul_eq_mul] + grind + · ext k + simp only [unif, Pi.add_apply, Pi.smul_apply, smul_eq_mul] + grind + +/-- The case of Section 5 of Pebody where the first distribution is `unif N` and the mixture is one +of `unif j` and `unif N`, with weight `α < 1` on `unif j`. -/ +private lemma compatible_top (ih : ∀ m < N, DecreasingCompatible m) {i j : ℕ} (hi : i ≤ N) + (hj : j ≤ N) {α : ℝ} (hα₀ : 0 ≤ α) (hα₁ : α < 1) (hsum : (i : ℝ) + α * j + (1 - α) * N = N) : + Compatible N (unif N) (unif i) (α • unif j + (1 - α) • unif N) := by + have hieq : (i : ℝ) = α * (N - j) := by linarith + obtain rfl | hi₀ := Nat.eq_zero_or_pos i + · rcases mul_eq_zero.1 (by simpa using hieq.symm : α * (N - j : ℝ) = 0) with rfl | hjN + · simpa using compatible_unif_zero.comm₁₂ + obtain rfl : j = N := by exact_mod_cast (by linarith : (j : ℝ) = N) + rw [← add_smul] + simpa using compatible_unif_zero.comm₁₂ + have hij : i + j < N := by + have : (0 : ℝ) < i := by exact_mod_cast hi₀ + exact_mod_cast (by nlinarith : (i + j : ℝ) < N) + obtain ⟨r, rfl⟩ : ∃ r, N = i + j + r + 1 := ⟨N - i - j - 1, by grind⟩ + have hα : α = i / (i + r + 1) := by + rw [eq_div_iff (by positivity)] + push_cast at hieq + linarith + rw [hα] + exact (compatible_lastcase (ih _ (by grind)) (ih _ (by grind))).comm₁₂ + +/-- The case of Section 5 of Pebody where the first distribution is `unif N` and the mixture has +mass at `N`. -/ +private lemma compatible_unif_top_mix (ih : ∀ m < N, DecreasingCompatible m) {i y z : ℕ} + (hi : i ≤ N) (hy : y ≤ N) (hz : z ≤ N) {α : ℝ} (hα₀ : 0 ≤ α) (hα₁ : α ≤ 1) + (hyz : y = N ∧ α ≠ 0 ∨ z = N ∧ α ≠ 1) (hsum : (i + N + α * y + (1 - α) * z : ℝ) = 2 * N) : + Compatible N (unif N) (unif i) (α • unif y + (1 - α) • unif z) := by + rcases hyz with ⟨rfl, hα0⟩ | ⟨rfl, hα1⟩ + · have h := compatible_top ih hi hz (α := 1 - α) (by linarith) + (by linarith [lt_of_le_of_ne hα₀ (Ne.symm hα0)]) (by linarith) + rwa [sub_sub_cancel, add_comm ((1 - α) • unif z)] at h + · exact compatible_top ih hi hy hα₀ (lt_of_le_of_ne hα₁ hα1) (by linarith) + +/-- `unif k₁`, `unif k₂` and `α • unif y + (1 - α) • unif z` are compatible at level `N` when their +means sum to `N`, given Pebody's theorem at lower levels. -/ +lemma compatible_unif_mix (ih : ∀ m < N, DecreasingCompatible m) {k₁ k₂ y z : ℕ} (hk₁ : k₁ ≤ N) + (hk₂ : k₂ ≤ N) (hy : y ≤ N) (hz : z ≤ N) {α : ℝ} (hα₀ : 0 ≤ α) (hα₁ : α ≤ 1) + (hsum : (k₁ + k₂ + α * y + (1 - α) * z : ℝ) = 2 * N) : + Compatible N (unif k₁) (unif k₂) (α • unif y + (1 - α) • unif z) := by + obtain rfl | hN := eq_or_ne N 0 + · obtain ⟨rfl, rfl, rfl, rfl⟩ : k₁ = 0 ∧ k₂ = 0 ∧ y = 0 ∧ z = 0 := by grind + rw [← add_smul, add_sub_cancel, one_smul] + exact compatible_unif_zero + have hd := isDecreasingOn_mix hy hz hα₀ hα₁ + have hm := mass_mix hy hz α + have hmom : moment N (unif k₁) + moment N (unif k₂) + + moment N (α • unif y + (1 - α) • unif z) = N := by + rw [moment_unif hk₁, moment_unif hk₂, moment_mix hy hz] + linarith + by_cases hA : k₁ < N ∧ k₂ < N + · obtain ⟨hA₁, hA₂⟩ := hA + exact (compatible_of_eq_zero_of_eq_zero_of_mass_eq_one ih hN hd (isDecreasingOn_unif hk₁) + (isDecreasingOn_unif hk₂) (unif_eq_zero hA₁) (unif_eq_zero hA₂) hm (mass_unif hk₁) + (mass_unif hk₂) (by linarith)).comm₁₂.comm₂₃ + by_cases hQ : (y < N ∨ α = 0) ∧ (z < N ∨ α = 1) + · obtain ⟨hQy, hQz⟩ := hQ + obtain hk₂N | rfl := hk₂.lt_or_eq + · exact compatible_of_eq_zero_of_eq_zero_of_mass_eq_one ih hN (isDecreasingOn_unif hk₁) + (isDecreasingOn_unif hk₂) hd (unif_eq_zero hk₂N) (mix_eq_zero hQy hQz) (mass_unif hk₁) + (mass_unif hk₂) hm hmom + obtain hk₁N | rfl := hk₁.lt_or_eq + · exact (compatible_of_eq_zero_of_eq_zero_of_mass_eq_one ih hN (isDecreasingOn_unif hk₂) + (isDecreasingOn_unif hk₁) hd (unif_eq_zero hk₁N) (mix_eq_zero hQy hQz) (mass_unif hk₂) + (mass_unif hk₁) hm (by linarith)).comm₁₂ + rw [mix_eq_unif_zero hα₀ hα₁ (by linarith)] + exact compatible_unif_zero.comm₁₃ + rcases (by grind : k₁ = N ∨ k₂ = N) with rfl | rfl + · exact compatible_unif_top_mix ih hk₂ hy hz hα₀ hα₁ (by grind) (by linarith) + · exact (compatible_unif_top_mix ih hk₁ hy hz hα₀ hα₁ (by grind) (by linarith)).comm₁₂ + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/Embedding.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/Embedding.lean new file mode 100644 index 0000000000..90f19b2590 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/Embedding.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Exponent +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Triangle.Basic +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.DisjointTriangles.Pruning + +/-! +# Lifting triangles to general position + +Fox and Lovász map `x ↦ (x, 1, 0)`, `y ↦ (y, -1, 1)` and `z ↦ (z, 0, -1)` into +`V × ZMod p × ZMod p`. The map preserves triangles, the first two vertices of each lifted triangle +are linearly independent, and their span contains the first two vertices of no other lifted +triangle. The pruning bound therefore holds for all `X`, `Y` and `Z`, with `#V` replaced by +`p ^ 2 * #V`. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.lift p a b x`: the vector `(x, a, b)`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.card_triangles_image_lift`: lifting preserves the number + of triangles. +* `ArithmeticTriangleRemovalInVectorSpaces.linearIndependent_of_mem_triangles_image_lift`: the + first two vertices of a triangle of the lifted sets are linearly independent. +* `ArithmeticTriangleRemovalInVectorSpaces.eq_of_mem_span_of_mem_triangles_image_lift`: their span + contains the first two vertices of no other triangle of the lifted sets. +* `ArithmeticTriangleRemovalInVectorSpaces.rpow_le_mul_card_rpow_mul_card_triangles_rpow`: the + pruning bound `(η * m / 2) ^ (1 + c p) ≤ 125 * p ^ 2 * (p ^ 2 * #V) ^ (1 - c p) * D ^ c p` for + `m` vertex-disjoint triangles in `X × Y × Z`. +-/ + +public section + +open Finset Function Submodule + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {V : Type*} + +/-- The vector `(x, a, b)` of `V × ZMod p × ZMod p`. -/ +private def lift (p : ℕ) (a b : ZMod p) (x : V) : V × ZMod p × ZMod p := + (x, a, b) + +private lemma lift_injective (p : ℕ) (a b : ZMod p) : Injective (lift (V := V) p a b) := + fun _ _ h ↦ congrArg Prod.fst h + +variable [AddCommGroup V] {p : ℕ} + +/-- Lifting `X`, `Y` and `Z` preserves the number of triangles. -/ +private lemma card_triangles_image_lift [DecidableEq V] (X Y Z : Finset V) : + #(triangles (X.image (lift p 1 0)) (Y.image (lift p (-1) 1)) (Z.image (lift p 0 (-1)))) = + #(triangles X Y Z) := by + symm + refine card_nbij' (fun (x, y, z) ↦ (lift p 1 0 x, lift p (-1) 1 y, lift p 0 (-1) z)) + (fun ((x, _), (y, _), (z, _)) ↦ (x, y, z)) ?_ ?_ ?_ ?_ + · rintro ⟨x, y, z⟩ h + simp only [mem_coe, mem_triangles, mem_image] at h ⊢ + obtain ⟨hx, hy, hz, h⟩ := h + refine ⟨⟨x, hx, rfl⟩, ⟨y, hy, rfl⟩, ⟨z, hz, rfl⟩, ?_⟩ + simp [lift, Prod.ext_iff, h] + · rintro ⟨a, b, c⟩ h + simp only [mem_coe, mem_triangles, mem_image] at h ⊢ + obtain ⟨⟨x, hx, rfl⟩, ⟨y, hy, rfl⟩, ⟨z, hz, rfl⟩, h⟩ := h + simp only [lift, Prod.ext_iff, Prod.fst_add, Prod.fst_zero] at h ⊢ + obtain ⟨h, -⟩ := h + exact ⟨hx, hy, hz, h⟩ + · rintro ⟨x, y, z⟩ - + rfl + · rintro ⟨a, b, c⟩ h + simp only [mem_coe, mem_triangles, mem_image] at h + obtain ⟨⟨x, hx, rfl⟩, ⟨y, hy, rfl⟩, ⟨z, hz, rfl⟩, -⟩ := h + rfl + +variable [Module (ZMod p) V] + +/-- The first two vertices `(x, 1, 0)` and `(y, -1, 1)` of a lifted triangle are linearly +independent. -/ +private lemma linearIndependent_lift (x y : V) : + LinearIndependent (ZMod p) ![lift p 1 0 x, lift p (-1) 1 y] := by + rw [LinearIndependent.pair_iff] + intro s t h + simp only [lift, Prod.ext_iff, Prod.smul_mk, Prod.fst_add, Prod.snd_add, Prod.fst_zero, + Prod.snd_zero, smul_eq_mul] at h + grind + +/-- If `(x', 1, 0)` lies in the span of `(x, 1, 0)` and `(y, -1, 1)`, then `x' = x`. -/ +private lemma eq_of_lift_mem_span_left {x y x' : V} + (h : lift p 1 0 x' ∈ span (ZMod p) {lift p 1 0 x, lift p (-1) 1 y}) : x' = x := by + obtain ⟨s, t, h⟩ := mem_span_pair.1 h + simp only [lift, Prod.ext_iff, Prod.smul_mk, Prod.fst_add, Prod.snd_add, smul_eq_mul] at h + obtain ⟨h₁, h₂, h₃⟩ := h + obtain rfl : t = 0 := by simpa using h₃ + obtain rfl : s = 1 := by simpa using h₂ + simpa using h₁.symm + +/-- If `(y', -1, 1)` lies in the span of `(x, 1, 0)` and `(y, -1, 1)`, then `y' = y`. -/ +private lemma eq_of_lift_mem_span_right {x y y' : V} + (h : lift p (-1) 1 y' ∈ span (ZMod p) {lift p 1 0 x, lift p (-1) 1 y}) : y' = y := by + obtain ⟨s, t, h⟩ := mem_span_pair.1 h + simp only [lift, Prod.ext_iff, Prod.smul_mk, Prod.fst_add, Prod.snd_add, smul_eq_mul] at h + obtain ⟨h₁, h₂, h₃⟩ := h + obtain rfl : t = 1 := by simpa using h₃ + obtain rfl : s = 0 := by simpa using h₂ + simpa using h₁.symm + +variable [DecidableEq V] {X Y Z : Finset V} + +section GeneralPosition + +variable {a b c a' b' c' : V × ZMod p × ZMod p} + +/-- The first two vertices of a triangle of the lifted sets are linearly independent. -/ +private lemma linearIndependent_of_mem_triangles_image_lift + (h : (a, b, c) ∈ + triangles (X.image (lift p 1 0)) (Y.image (lift p (-1) 1)) (Z.image (lift p 0 (-1)))) : + LinearIndependent (ZMod p) ![a, b] := by + simp only [mem_triangles, mem_image] at h + obtain ⟨⟨x, -, rfl⟩, ⟨y, -, rfl⟩, -⟩ := h + exact linearIndependent_lift x y + +/-- The span of the first two vertices of a triangle of the lifted sets contains the first two +vertices of no other triangle of the lifted sets. -/ +private lemma eq_of_mem_span_of_mem_triangles_image_lift + (h : (a, b, c) ∈ + triangles (X.image (lift p 1 0)) (Y.image (lift p (-1) 1)) (Z.image (lift p 0 (-1)))) + (h' : (a', b', c') ∈ + triangles (X.image (lift p 1 0)) (Y.image (lift p (-1) 1)) (Z.image (lift p 0 (-1)))) + (ha : a' ∈ span (ZMod p) {a, b}) (hb : b' ∈ span (ZMod p) {a, b}) : a' = a ∧ b' = b := by + simp only [mem_triangles, mem_image] at h h' + obtain ⟨⟨x, -, rfl⟩, ⟨y, -, rfl⟩, -⟩ := h + obtain ⟨⟨x', -, rfl⟩, ⟨y', -, rfl⟩, -⟩ := h' + rw [eq_of_lift_mem_span_left ha, eq_of_lift_mem_span_right hb] + exact ⟨rfl, rfl⟩ + +end GeneralPosition + +variable [Fact p.Prime] [Fintype V] {ι : Type*} [Fintype ι] {x y z : ι → V} + +/-- **Pruning in general position.** If `X × Y × Z` contains `m` vertex-disjoint triangles +`(x i, y i, z i)`, then +`(η * m / 2) ^ (1 + c p) ≤ 125 * p ^ 2 * (p ^ 2 * #V) ^ (1 - c p) * D ^ c p`, where +`η = c p / (1 + c p)` and `D` is the number of triangles. -/ +lemma rpow_le_mul_card_rpow_mul_card_triangles_rpow (hx : Injective x) (hy : Injective y) + (hz : Injective z) (hxX : ∀ i, x i ∈ X) (hyY : ∀ i, y i ∈ Y) (hzZ : ∀ i, z i ∈ Z) + (hsum : ∀ i, x i + y i + z i = 0) : + (c p / (1 + c p) * Fintype.card ι / 2) ^ (1 + c p) ≤ + 125 * p ^ 2 * (p ^ 2 * Fintype.card V) ^ (1 - c p) * #(triangles X Y Z) ^ c p := by + have h := rpow_le_mul_rpow_mul_card_triangles_rpow (p := p) + (fun _ _ _ ↦ linearIndependent_of_mem_triangles_image_lift) + (fun _ _ _ h _ _ _ h' ↦ eq_of_mem_span_of_mem_triangles_image_lift h h') + ((lift_injective _ _ _).comp hx) ((lift_injective _ _ _).comp hy) + ((lift_injective _ _ _).comp hz) (fun i ↦ mem_image_of_mem _ (hxX i)) + (fun i ↦ mem_image_of_mem _ (hyY i)) (fun i ↦ mem_image_of_mem _ (hzZ i)) + (fun i ↦ by simp [lift, Prod.ext_iff, hsum i]) + rw [card_triangles_image_lift, Fintype.card_prod, Fintype.card_prod, ZMod.card] at h + convert h using 4 + push_cast + ring + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/MaximalFamily.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/MaximalFamily.lean new file mode 100644 index 0000000000..68fcd9b9ad --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/MaximalFamily.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Exponent +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Triangle.Basic +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.DisjointTriangles.TensorPower + +/-! +# Removing a maximum family of vertex-disjoint triangles + +Let `S` be a family of vertex-disjoint triangles of `X × Y × Z` of maximum size. Removing the +vertices of `S` from `X`, `Y` and `Z` leaves no triangle, and costs at most `3 * #S` elements. By +Theorem 3 of Fox and Lovász, `X × Y × Z` contains at least `(#S / #V) ^ C p * #V ^ 2` triangles. +This proves Theorem 1 of Fox and Lovász in every finite vector space over `ZMod p`. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.IsVertexDisjoint S`: no two triangles of `S` share a + vertex. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.triangles_sdiff_image_eq_empty`: removing the vertices + of a maximum family of vertex-disjoint triangles leaves no triangle. +* `ArithmeticTriangleRemovalInVectorSpaces.three_mul_card_le_of_card_triangles_lt`: a family of + vertex-disjoint triangles in `X × Y × Z` has at most `ε * #V / 3` members when `X × Y × Z` has + fewer than `(ε / 3) ^ C p * #V ^ 2` triangles. +* `ArithmeticTriangleRemovalInVectorSpaces.exists_subset_card_sdiff_add_le_of_card_triangles_lt`: + the arithmetic triangle removal lemma with `δ = (ε / 3) ^ C p`. +-/ + +public section + +open Finset Function + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {V : Type*} + +/-- A family of triangles is vertex-disjoint if no two of its triangles share a first, second or +third vertex: each of the three projections is injective on it. -/ +private def IsVertexDisjoint (S : Finset (V × V × V)) : Prop := + Set.InjOn (fun ((x, _, _) : V × V × V) ↦ x) S ∧ + Set.InjOn (fun ((_, y, _) : V × V × V) ↦ y) S ∧ Set.InjOn (fun ((_, _, z) : V × V × V) ↦ z) S + +/-- Removing the vertices of `S` from `X` removes at most `#S` elements. -/ +private lemma card_sdiff_sdiff_image_le {α : Type*} [DecidableEq α] (X : Finset α) + (S : Finset (V × V × V)) (f : V × V × V → α) : #(X \ (X \ S.image f)) ≤ #S := by + rw [sdiff_sdiff_right_self] + grw [card_le_card (inf_le_right : X ⊓ S.image f ≤ _), card_image_le] + +variable [DecidableEq V] {S : Finset (V × V × V)} {x y z : V} + +/-- Adding a triangle that shares no vertex with the triangles of a vertex-disjoint family keeps +the family vertex-disjoint. -/ +private lemma IsVertexDisjoint.insert (hS : IsVertexDisjoint S) + (hx : x ∉ S.image fun (x, _, _) ↦ x) (hy : y ∉ S.image fun (_, y, _) ↦ y) + (hz : z ∉ S.image fun (_, _, z) ↦ z) : IsVertexDisjoint (insert (x, y, z) S) := by + obtain ⟨h₁, h₂, h₃⟩ := hS + have hnot : (x, y, z) ∉ S := fun h ↦ hx (mem_image_of_mem _ h) + rw [IsVertexDisjoint, coe_insert, Set.injOn_insert (by simpa using hnot), + Set.injOn_insert (by simpa using hnot), Set.injOn_insert (by simpa using hnot)] + exact ⟨⟨h₁, by simpa using hx⟩, ⟨h₂, by simpa using hy⟩, h₃, by simpa using hz⟩ + +variable [AddCommGroup V] {X Y Z : Finset V} + +/-- Removing the vertices of a maximum family `S` of vertex-disjoint triangles leaves no +triangle. -/ +private lemma triangles_sdiff_image_eq_empty (hST : S ⊆ triangles X Y Z) (hS : IsVertexDisjoint S) + (hmax : ∀ S' ⊆ triangles X Y Z, IsVertexDisjoint S' → #S' ≤ #S) : + triangles (X \ S.image fun (x, _, _) ↦ x) (Y \ S.image fun (_, y, _) ↦ y) + (Z \ S.image fun (_, _, z) ↦ z) = ∅ := by + rw [eq_empty_iff_forall_notMem] + rintro ⟨x, y, z⟩ ht + simp only [mem_triangles, mem_sdiff] at ht + obtain ⟨⟨hx, hxS⟩, ⟨hy, hyS⟩, ⟨hz, hzS⟩, hsum⟩ := ht + have h := hmax _ (insert_subset (mem_triangles.2 ⟨hx, hy, hz, hsum⟩) hST) + (hS.insert hxS hyS hzS) + rw [card_insert_of_notMem fun h ↦ hxS (mem_image_of_mem _ h)] at h + grind + +variable {p : ℕ} [Fact p.Prime] [Module (ZMod p) V] [Fintype V] + +/-- **Theorem 3 for a family of triangles.** If `X × Y × Z` contains a family `S` of +vertex-disjoint triangles, then it contains at least `(#S / #V) ^ C p * #V ^ 2` triangles. -/ +private lemma div_rpow_C_mul_sq_le_card_triangles_of_isVertexDisjoint (hST : S ⊆ triangles X Y Z) + (hS : IsVertexDisjoint S) : + ((#S : ℝ) / Fintype.card V) ^ C p * Fintype.card V ^ 2 ≤ #(triangles X Y Z) := by + obtain ⟨h₁, h₂, h₃⟩ := hS + have h := div_rpow_C_mul_sq_le_card_triangles (p := p) (X := X) (Y := Y) (Z := Z) h₁.injective + h₂.injective h₃.injective ?_ ?_ ?_ ?_ + · simpa using h + all_goals + rintro ⟨⟨x, y, z⟩, ht⟩ + have := hST ht + simp_all + +/-- If `X × Y × Z` contains a family `S` of vertex-disjoint triangles and fewer than +`(ε / 3) ^ C p * #V ^ 2` triangles, then `3 * #S ≤ ε * #V`. -/ +private lemma three_mul_card_le_of_card_triangles_lt {ε : ℝ} (hε : 0 ≤ ε) + (hST : S ⊆ triangles X Y Z) + (hS : IsVertexDisjoint S) (h : #(triangles X Y Z) < (ε / 3) ^ C p * Fintype.card V ^ 2) : + 3 * #S ≤ ε * Fintype.card V := by + by_contra! hlt + have hC : 0 ≤ C p := by + rw [C] + linarith [one_div_pos.2 (c_pos (Fact.out : p.Prime).two_le)] + have hεS : ε / 3 ≤ #S / Fintype.card V := by + rw [div_le_div_iff₀ (by norm_num) (Nat.cast_pos.2 Fintype.card_pos)] + linarith + have h' := div_rpow_C_mul_sq_le_card_triangles_of_isVertexDisjoint (p := p) hST hS + grw [← hεS] at h' + linarith + +/-- **Theorem 1 of Fox and Lovász** in a finite vector space `V` over `ZMod p`. If `X × Y × Z` has +fewer than `(ε / 3) ^ C p * #V ^ 2` triangles, then removing at most `ε * #V` elements from `X`, +`Y` and `Z` leaves no triangle. -/ +lemma exists_subset_card_sdiff_add_le_of_card_triangles_lt {ε : ℝ} (hε : 0 ≤ ε) + (h : #(triangles X Y Z) < (ε / 3) ^ C p * Fintype.card V ^ 2) : + ∃ X' ⊆ X, ∃ Y' ⊆ Y, ∃ Z' ⊆ Z, + #(X \ X') + #(Y \ Y') + #(Z \ Z') ≤ ε * Fintype.card V ∧ triangles X' Y' Z' = ∅ := by + classical + obtain ⟨S, hS, hmax⟩ := exists_max_image ((triangles X Y Z).powerset.filter IsVertexDisjoint) + card ⟨∅, by simp [IsVertexDisjoint]⟩ + obtain ⟨hST, hS⟩ : S ⊆ triangles X Y Z ∧ IsVertexDisjoint S := by simpa using hS + refine ⟨_, sdiff_subset, _, sdiff_subset, _, sdiff_subset, ?_, + triangles_sdiff_image_eq_empty hST hS fun S' hS' hdisj ↦ hmax S' (by simp [hS', hdisj])⟩ + linarith [three_mul_card_le_of_card_triangles_lt hε hST hS h, + (Nat.cast_le (α := ℝ)).2 (card_sdiff_sdiff_image_le X S fun (x, _, _) ↦ x), + (Nat.cast_le (α := ℝ)).2 (card_sdiff_sdiff_image_le Y S fun (_, y, _) ↦ y), + (Nat.cast_le (α := ℝ)).2 (card_sdiff_sdiff_image_le Z S fun (_, _, z) ↦ z)] + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/Pruning.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/Pruning.lean new file mode 100644 index 0000000000..bc67180581 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/Pruning.lean @@ -0,0 +1,274 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Exponent +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Triangle.Basic +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.DisjointTriangles.Sampling +import Mathlib.Analysis.Convex.SpecificFunctions.Basic +import Mathlib.Tactic.Positivity.Finset + +/-! +# Pruning vertices of large degree + +Let `X × Y × Z` contain `D` triangles and `m` vertex-disjoint triangles `(x i, y i, z i)`. Fox and +Lovász remove vertices of large degree one at a time (Lemma 6). We choose instead, among all +`X' ⊆ X`, `Y' ⊆ Y` and `Z' ⊆ Z`, one minimizing the potential `r + A * D' ^ η`. Here `r` counts the +triangles `(x i, y i, z i)` outside `X' × Y' × Z'`, `D'` counts the triangles of `X' × Y' × Z'`, +`η = c p / (1 + c p)` and `A = m / (2 * D ^ η)`. Removing a vertex of degree `d` from a minimizer +raises `r` by at most one and lowers `D'` by `d`, so `d ≤ D' ^ (1 - η) / (A * η)`. Lemma 5 of Fox +and Lovász then gives `(η * m / 2) ^ (1 + c p) ≤ 125 * p ^ 2 * #V ^ (1 - c p) * D ^ c p`. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.potential`: the potential `r + A * D' ^ η`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.card_filter_fst_le_of_potential_le`: the degree bound + at a vertex whose removal does not lower the potential. +* `ArithmeticTriangleRemovalInVectorSpaces.card_triangles_pos_of_potential_le`: a configuration + whose potential is at most that of `(X, Y, Z)` contains a triangle. +* `ArithmeticTriangleRemovalInVectorSpaces.rpow_le_mul_rpow_mul_card_triangles_rpow`: the bound + `(η * m / 2) ^ (1 + c p) ≤ 125 * p ^ 2 * #V ^ (1 - c p) * D ^ c p`. +-/ + +public section + +open Finset Function Submodule + +namespace ArithmeticTriangleRemovalInVectorSpaces + +/-- A vertex of degree `d` whose removal from a configuration with `D` triangles does not lower the +potential satisfies `d ≤ D ^ (1 - η) / (A * η)`, by Bernoulli's inequality. -/ +private lemma le_rpow_one_sub_div_of_mul_rpow_le {A η D d : ℝ} (hA : 0 < A) (hη₀ : 0 < η) + (hη₁ : η ≤ 1) (hd₀ : 0 ≤ d) (hdD : d ≤ D) (h : A * D ^ η ≤ 1 + A * (D - d) ^ η) : + d ≤ D ^ (1 - η) / (A * η) := by + rcases hd₀.eq_or_lt with rfl | hd + · positivity + have hD : 0 < D := hd.trans_le hdD + have hB : (D - d) ^ η ≤ D ^ η * (1 - η * (d / D)) := by + rw [(by field_simp : D - d = D * (1 - d / D)), + Real.mul_rpow hD.le (sub_nonneg.2 ((div_le_one hD).2 hdD))] + gcongr + simpa [sub_eq_add_neg] using + rpow_one_add_le_one_add_mul_self (neg_le_neg ((div_le_one hD).2 hdD)) hη₀.le hη₁ + have key : A * D ^ η * η * (d / D) ≤ 1 := by linarith [mul_le_mul_of_nonneg_left hB hA.le] + rw [mul_div_assoc', div_le_one hD] at key + rw [Real.rpow_sub hD, Real.rpow_one, div_div, le_div_iff₀ (by positivity)] + linarith + +/-- If `(1 - η) * (1 + c) = 1` and `D' ≤ K * (D' ^ (1 - η) / B / N) ^ (1 + c) * N ^ 2`, then +`B ^ (1 + c) ≤ K * N ^ (1 - c)`. -/ +private lemma rpow_le_mul_rpow_of_le_mul_div_rpow {K N D' B c η : ℝ} (hN : 0 < N) (hD' : 0 < D') + (hB : 0 < B) (hη : (1 - η) * (1 + c) = 1) + (h : D' ≤ K * (D' ^ (1 - η) / B / N) ^ (1 + c) * N ^ 2) : + B ^ (1 + c) ≤ K * N ^ (1 - c) := by + have hN2 : N ^ 2 = N ^ (1 + c) * N ^ (1 - c) := by + rw [← Real.rpow_add hN] + norm_num + rw [Real.div_rpow (by positivity) hN.le, Real.div_rpow (by positivity) hB.le, + ← Real.rpow_mul hD'.le, hη, Real.rpow_one, hN2] at h + field_simp at h + exact h + +/-- The arithmetic of the pruning argument: Lemma 5 of Fox and Lovász for the degree bound +`D' ^ (1 - η) / (A * η)` with `A = m / (2 * D ^ η)` gives +`(η * m / 2) ^ (1 + c) ≤ K * N ^ (1 - c) * D ^ c`. -/ +private lemma rpow_le_mul_rpow_mul_rpow_of_le {K N D D' m c : ℝ} (hc : 0 < c) (hN : 0 < N) + (hD : 0 < D) (hD' : 0 < D') (hm : 0 < m) + (h : D' ≤ K * (D' ^ (1 - c / (1 + c)) / (m / (2 * D ^ (c / (1 + c))) * (c / (1 + c))) / N) ^ + (1 + c) * N ^ 2) : + (c / (1 + c) * m / 2) ^ (1 + c) ≤ K * N ^ (1 - c) * D ^ c := by + have h := rpow_le_mul_rpow_of_le_mul_div_rpow hN hD' (by positivity) (by grind) h + rwa [(by field_simp : m / (2 * D ^ (c / (1 + c))) * (c / (1 + c)) = + c / (1 + c) * m / 2 / D ^ (c / (1 + c))), Real.div_rpow (by positivity) (by positivity), + ← Real.rpow_mul hD.le, (by grind : c / (1 + c) * (1 + c) = c), + div_le_iff₀ (by positivity)] at h + +variable {V ι : Type*} [AddCommGroup V] [DecidableEq V] [Fintype ι] {x y z : ι → V} + +/-- The potential `r + A * D' ^ η` of `(X, Y, Z)`: `r` counts the indices `i` such that +`(x i, y i, z i)` does not lie in `X × Y × Z`, and `D'` counts the triangles of `X × Y × Z`. -/ +private noncomputable def potential (x y z : ι → V) (A η : ℝ) : Finset V × Finset V × Finset V → ℝ + | (X, Y, Z) => #{i | ¬(x i ∈ X ∧ y i ∈ Y ∧ z i ∈ Z)} + A * #(triangles X Y Z) ^ η + +omit [AddCommGroup V] in +/-- An injective family takes each value at most once. -/ +private lemma card_filter_apply_eq_le_one {f : ι → V} (hf : Injective f) (v : V) : + #{i | f i = v} ≤ 1 := + card_le_one.2 fun _ _ _ _ ↦ hf (by simp_all) + +omit [AddCommGroup V] in +/-- Removing a vertex from `X` puts at most one more vertex-disjoint triangle outside. -/ +private lemma card_filter_not_mem_erase_left_le (hx : Injective x) (X Y Z : Finset V) (v : V) : + #{i | ¬(x i ∈ X.erase v ∧ y i ∈ Y ∧ z i ∈ Z)} ≤ #{i | ¬(x i ∈ X ∧ y i ∈ Y ∧ z i ∈ Z)} + 1 := by + classical + grw [← card_filter_apply_eq_le_one hx v, ← card_union_le] + apply card_le_card + intro i + simp only [mem_filter, mem_univ, true_and, mem_union, mem_erase] + tauto + +omit [AddCommGroup V] in +/-- Removing a vertex from `Y` puts at most one more vertex-disjoint triangle outside. -/ +private lemma card_filter_not_mem_erase_middle_le (hy : Injective y) (X Y Z : Finset V) (v : V) : + #{i | ¬(x i ∈ X ∧ y i ∈ Y.erase v ∧ z i ∈ Z)} ≤ #{i | ¬(x i ∈ X ∧ y i ∈ Y ∧ z i ∈ Z)} + 1 := by + classical + grw [← card_filter_apply_eq_le_one hy v, ← card_union_le] + apply card_le_card + intro i + simp only [mem_filter, mem_univ, true_and, mem_union, mem_erase] + tauto + +omit [AddCommGroup V] in +/-- Removing a vertex from `Z` puts at most one more vertex-disjoint triangle outside. -/ +private lemma card_filter_not_mem_erase_right_le (hz : Injective z) (X Y Z : Finset V) (v : V) : + #{i | ¬(x i ∈ X ∧ y i ∈ Y ∧ z i ∈ Z.erase v)} ≤ #{i | ¬(x i ∈ X ∧ y i ∈ Y ∧ z i ∈ Z)} + 1 := by + classical + grw [← card_filter_apply_eq_le_one hz v, ← card_union_le] + apply card_le_card + intro i + simp only [mem_filter, mem_univ, true_and, mem_union, mem_erase] + tauto + +variable {A η : ℝ} {X Y Z X' Y' Z' : Finset V} {v : V} + +/-- If removing `v` from `X` does not lower the potential, then `v` lies in at most +`D' ^ (1 - η) / (A * η)` triangles. -/ +private lemma card_filter_fst_le_of_potential_le (hx : Injective x) (hA : 0 < A) (hη₀ : 0 < η) + (hη₁ : η ≤ 1) (h : potential x y z A η (X, Y, Z) ≤ potential x y z A η (X.erase v, Y, Z)) : + #((triangles X Y Z).filter fun (x, _, _) ↦ x = v) ≤ + #(triangles X Y Z) ^ (1 - η) / (A * η) := by + refine le_rpow_one_sub_div_of_mul_rpow_le hA hη₀ hη₁ (Nat.cast_nonneg _) + (by exact_mod_cast card_filter_le _ _) ?_ + have hr : (#{i | ¬(x i ∈ X.erase v ∧ y i ∈ Y ∧ z i ∈ Z)} : ℝ) ≤ + #{i | ¬(x i ∈ X ∧ y i ∈ Y ∧ z i ∈ Z)} + 1 := by + exact_mod_cast card_filter_not_mem_erase_left_le hx X Y Z v + simp only [potential, ← card_triangles_erase_left X Y Z v] at h ⊢ + push_cast at h ⊢ + rw [add_sub_cancel_right] + linarith + +/-- If removing `v` from `Y` does not lower the potential, then `v` lies in at most +`D' ^ (1 - η) / (A * η)` triangles. -/ +private lemma card_filter_snd_le_of_potential_le (hy : Injective y) (hA : 0 < A) (hη₀ : 0 < η) + (hη₁ : η ≤ 1) (h : potential x y z A η (X, Y, Z) ≤ potential x y z A η (X, Y.erase v, Z)) : + #((triangles X Y Z).filter fun (_, y, _) ↦ y = v) ≤ + #(triangles X Y Z) ^ (1 - η) / (A * η) := by + refine le_rpow_one_sub_div_of_mul_rpow_le hA hη₀ hη₁ (Nat.cast_nonneg _) + (by exact_mod_cast card_filter_le _ _) ?_ + have hr : (#{i | ¬(x i ∈ X ∧ y i ∈ Y.erase v ∧ z i ∈ Z)} : ℝ) ≤ + #{i | ¬(x i ∈ X ∧ y i ∈ Y ∧ z i ∈ Z)} + 1 := by + exact_mod_cast card_filter_not_mem_erase_middle_le hy X Y Z v + simp only [potential, ← card_triangles_erase_middle X Y Z v] at h ⊢ + push_cast at h ⊢ + rw [add_sub_cancel_right] + linarith + +/-- If removing `v` from `Z` does not lower the potential, then `v` lies in at most +`D' ^ (1 - η) / (A * η)` triangles. -/ +private lemma card_filter_thd_le_of_potential_le (hz : Injective z) (hA : 0 < A) (hη₀ : 0 < η) + (hη₁ : η ≤ 1) (h : potential x y z A η (X, Y, Z) ≤ potential x y z A η (X, Y, Z.erase v)) : + #((triangles X Y Z).filter fun (_, _, z) ↦ z = v) ≤ + #(triangles X Y Z) ^ (1 - η) / (A * η) := by + refine le_rpow_one_sub_div_of_mul_rpow_le hA hη₀ hη₁ (Nat.cast_nonneg _) + (by exact_mod_cast card_filter_le _ _) ?_ + have hr : (#{i | ¬(x i ∈ X ∧ y i ∈ Y ∧ z i ∈ Z.erase v)} : ℝ) ≤ + #{i | ¬(x i ∈ X ∧ y i ∈ Y ∧ z i ∈ Z)} + 1 := by + exact_mod_cast card_filter_not_mem_erase_right_le hz X Y Z v + simp only [potential, ← card_triangles_erase_right X Y Z v] at h ⊢ + push_cast at h ⊢ + rw [add_sub_cancel_right] + linarith + +/-- If `(x i, y i, z i)` lies in `X × Y × Z` for every `i`, then the potential of `(X, Y, Z)` is +`A * D ^ η`. -/ +private lemma potential_eq_mul_rpow (hxX : ∀ i, x i ∈ X) (hyY : ∀ i, y i ∈ Y) (hzZ : ∀ i, z i ∈ Z) : + potential x y z A η (X, Y, Z) = A * #(triangles X Y Z) ^ η := by + simp [potential, hxX, hyY, hzZ] + +/-- If `X × Y × Z` contains no triangle, then its potential is the number of indices. -/ +private lemma potential_eq_card_of_triangles_eq_empty (hsum : ∀ i, x i + y i + z i = 0) (hη : η ≠ 0) + (h : triangles X Y Z = ∅) : potential x y z A η (X, Y, Z) = Fintype.card ι := by + have hout (i : ι) : ¬(x i ∈ X ∧ y i ∈ Y ∧ z i ∈ Z) := by + rintro ⟨hx, hy, hz⟩ + simpa [h] using mem_triangles.2 ⟨hx, hy, hz, hsum i⟩ + simp [potential, hout, h, Real.zero_rpow hη] + +omit [Fintype ι] in +/-- If `X × Y × Z` contains the triangles `(x i, y i, z i)` and there is at least one index, then +`X × Y × Z` contains a triangle. -/ +lemma card_triangles_pos [Nonempty ι] (hxX : ∀ i, x i ∈ X) (hyY : ∀ i, y i ∈ Y) + (hzZ : ∀ i, z i ∈ Z) (hsum : ∀ i, x i + y i + z i = 0) : 0 < #(triangles X Y Z) := by + obtain ⟨i⟩ := ‹Nonempty ι› + exact card_pos.2 ⟨_, mem_triangles.2 ⟨hxX i, hyY i, hzZ i, hsum i⟩⟩ + +/-- Let `X × Y × Z` contain the triangles `(x i, y i, z i)`, `D` triangles in total, and take +`A = m / (2 * D ^ η)`. If the potential of `(X', Y', Z')` is at most that of `(X, Y, Z)`, then +`X' × Y' × Z'` contains a triangle: otherwise its potential is `m`, whereas that of `(X, Y, Z)` is +`m / 2`. -/ +private lemma card_triangles_pos_of_potential_le [Nonempty ι] (hsum : ∀ i, x i + y i + z i = 0) + (hxX : ∀ i, x i ∈ X) (hyY : ∀ i, y i ∈ Y) (hzZ : ∀ i, z i ∈ Z) (hη : η ≠ 0) + (h : potential x y z (Fintype.card ι / (2 * #(triangles X Y Z) ^ η)) η (X', Y', Z') ≤ + potential x y z (Fintype.card ι / (2 * #(triangles X Y Z) ^ η)) η (X, Y, Z)) : + 0 < #(triangles X' Y' Z') := by + have hD := card_triangles_pos hxX hyY hzZ hsum + rw [card_pos, nonempty_iff_ne_empty] + intro hT + rw [potential_eq_card_of_triangles_eq_empty hsum hη hT, potential_eq_mul_rpow hxX hyY hzZ] at h + field_simp at h + linarith [(by positivity : (0 : ℝ) < Fintype.card ι)] + +variable {p : ℕ} [Fact p.Prime] [Module (ZMod p) V] [Fintype V] + +/-- **Pruning.** If the first two vertices of each triangle of `X × Y × Z` are linearly +independent, their span contains the first two vertices of no other triangle, and `X × Y × Z` +contains `m` vertex-disjoint triangles `(x i, y i, z i)`, then +`(η * m / 2) ^ (1 + c p) ≤ 125 * p ^ 2 * #V ^ (1 - c p) * D ^ c p`, where `η = c p / (1 + c p)` +and `D` is the number of triangles. -/ +lemma rpow_le_mul_rpow_mul_card_triangles_rpow + (hli : ∀ x y z, (x, y, z) ∈ triangles X Y Z → LinearIndependent (ZMod p) ![x, y]) + (hspan : ∀ x y z, (x, y, z) ∈ triangles X Y Z → ∀ x' y' z', (x', y', z') ∈ triangles X Y Z → + x' ∈ span (ZMod p) {x, y} → y' ∈ span (ZMod p) {x, y} → x' = x ∧ y' = y) + (hx : Injective x) (hy : Injective y) (hz : Injective z) (hxX : ∀ i, x i ∈ X) + (hyY : ∀ i, y i ∈ Y) (hzZ : ∀ i, z i ∈ Z) (hsum : ∀ i, x i + y i + z i = 0) : + (c p / (1 + c p) * Fintype.card ι / 2) ^ (1 + c p) ≤ + 125 * p ^ 2 * Fintype.card V ^ (1 - c p) * #(triangles X Y Z) ^ c p := by + have hc := c_pos (Fact.out : p.Prime).two_le + rcases isEmpty_or_nonempty ι with hι | hι + · simp only [Fintype.card_eq_zero, Nat.cast_zero, mul_zero, zero_div, + Real.zero_rpow (by linarith : 1 + c p ≠ 0)] + positivity + have hD := card_triangles_pos hxX hyY hzZ hsum + have hA : 0 < (Fintype.card ι : ℝ) / (2 * #(triangles X Y Z) ^ (c p / (1 + c p))) := by + positivity + obtain ⟨⟨X', Y', Z'⟩, hS, hmin⟩ := exists_min_image (X.powerset ×ˢ Y.powerset ×ˢ Z.powerset) + (potential x y z ((Fintype.card ι : ℝ) / (2 * #(triangles X Y Z) ^ (c p / (1 + c p)))) + (c p / (1 + c p))) ⟨(X, Y, Z), by simp⟩ + obtain ⟨hX', hY', hZ'⟩ : X' ⊆ X ∧ Y' ⊆ Y ∧ Z' ⊆ Z := by simpa using hS + have hη₁ : c p / (1 + c p) ≤ 1 := (div_le_one (by positivity)).2 (by linarith) + refine rpow_le_mul_rpow_mul_rpow_of_le hc (by positivity) (by positivity) + (Nat.cast_pos.2 (card_triangles_pos_of_potential_le hsum hxX hyY hzZ (by positivity) + (hmin _ (by simp)))) (by positivity) ?_ + refine card_triangles_le_of_degree_le + (fun a b c ht ↦ hli a b c (triangles_mono hX' hY' hZ' ht)) + (fun a b c ht a' b' c' ht' ↦ hspan a b c (triangles_mono hX' hY' hZ' ht) a' b' c' + (triangles_mono hX' hY' hZ' ht')) ?_ ?_ ?_ + · intro v + rw [div_mul_cancel₀ _ (by positivity)] + exact card_filter_fst_le_of_potential_le hx hA (by positivity) hη₁ + (hmin _ (by simp [hY', hZ', (erase_subset v X').trans hX'])) + · intro v + rw [div_mul_cancel₀ _ (by positivity)] + exact card_filter_snd_le_of_potential_le hy hA (by positivity) hη₁ + (hmin _ (by simp [hX', hZ', (erase_subset v Y').trans hY'])) + · intro v + rw [div_mul_cancel₀ _ (by positivity)] + exact card_filter_thd_le_of_potential_le hz hA (by positivity) hη₁ + (hmin _ (by simp [hX', hY', (erase_subset v Z').trans hZ'])) + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/Sampling.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/Sampling.lean new file mode 100644 index 0000000000..209546fd81 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/Sampling.lean @@ -0,0 +1,500 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Exponent +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Triangle.Basic +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.LinearMap.Card +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.TensorPower +import Mathlib.Algebra.Field.ZMod +import Mathlib.Analysis.Convex.Jensen +import Mathlib.Analysis.Convex.SpecificFunctions.Pow +import Mathlib.Tactic.Positivity.Finset + +/-! +# Few triangles when all degrees are small + +This file proves Lemma 5 of Fox and Lovász: if every vertex of `X × Y × Z` lies in at most +`R = ρ * N` triangles, then there are at most `125 * p ^ 2 * ρ ^ (1 + c p) * N ^ 2` triangles. As in +the paper, the first two vertices of each triangle are linearly independent, and no plane contains +the first two vertices of two triangles. The paper intersects `X`, `Y` and `Z` with a uniformly +random subspace of dimension `d`; we use the kernel of a uniformly random linear map +`A : V →ₗ[ZMod p] W`. Its kernel contains `r` given independent vectors with probability +`#W ^ (-r)`, and the expected value of `#(ker A) ^ (1 - c p)` is at most `(1 + #V / #W) ^ (1 - c p)` +by Jensen's inequality. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.adjacentTriangles X Y Z x y z`: the triangles of + `X × Y × Z` other than `(x, y, z)` that share a vertex with it. +* `ArithmeticTriangleRemovalInVectorSpaces.goodTriangles X Y Z`: the triangles of `X × Y × Z` that + share no vertex with another triangle of `X × Y × Z`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.isMulticoloredSumFree_goodTriangles`: the good triangles + form a multicolored sum-free family. +* `ArithmeticTriangleRemovalInVectorSpaces.card_filter_mem_goodTriangles_ge`: a triangle is good in + the kernel of at least a proportion `(1 - 3 * R / #W) / #W ^ 2` of the linear maps. +* `ArithmeticTriangleRemovalInVectorSpaces.two_mul_card_triangles_le`: the bound + `2 * #(triangles X Y Z) ≤ 5 * #W ^ 2 * (1 + #V / #W) ^ (1 - c p)` when `5 * R ≤ #W`. +* `ArithmeticTriangleRemovalInVectorSpaces.card_triangles_le_of_degree_le`: Lemma 5 of Fox and + Lovász. +-/ + +public section + +open Finset Module Submodule + +namespace ArithmeticTriangleRemovalInVectorSpaces + +section Good + +variable {G : Type*} [AddCommGroup G] [DecidableEq G] + +/-- The triangles of `X × Y × Z` other than `(x, y, z)` that share a vertex with it. -/ +private def adjacentTriangles (X Y Z : Finset G) (x y z : G) : Finset (G × G × G) := + (triangles X Y Z).filter fun (x', y', z') ↦ (x' = x ∨ y' = y ∨ z' = z) ∧ (x', y', z') ≠ (x, y, z) + +/-- The good triangles of Fox and Lovász: the triangles of `X × Y × Z` that share no vertex with +another triangle of `X × Y × Z`. -/ +private def goodTriangles (X Y Z : Finset G) : Finset (G × G × G) := + (triangles X Y Z).filter fun (x, y, z) ↦ adjacentTriangles X Y Z x y z = ∅ + +variable {X Y Z X' Y' Z' : Finset G} {x y z x' y' z' : G} + +@[simp] +private lemma mem_adjacentTriangles : + (x', y', z') ∈ adjacentTriangles X Y Z x y z ↔ + (x', y', z') ∈ triangles X Y Z ∧ (x' = x ∨ y' = y ∨ z' = z) ∧ (x', y', z') ≠ (x, y, z) := + mem_filter + +@[simp] +private lemma mem_goodTriangles : + (x, y, z) ∈ goodTriangles X Y Z ↔ + (x, y, z) ∈ triangles X Y Z ∧ adjacentTriangles X Y Z x y z = ∅ := + mem_filter + +private lemma goodTriangles_subset (X Y Z : Finset G) : goodTriangles X Y Z ⊆ triangles X Y Z := + filter_subset _ _ + +private lemma adjacentTriangles_mono (hX : X' ⊆ X) (hY : Y' ⊆ Y) (hZ : Z' ⊆ Z) : + adjacentTriangles X' Y' Z' x y z ⊆ adjacentTriangles X Y Z x y z := + filter_subset_filter _ (triangles_mono hX hY hZ) + +/-- A triangle that shares a vertex with a good triangle `(x, y, z)` is `(x, y, z)` itself. -/ +private lemma eq_of_mem_goodTriangles (ht : (x, y, z) ∈ goodTriangles X Y Z) + (ht' : (x', y', z') ∈ triangles X Y Z) (h : x' = x ∨ y' = y ∨ z' = z) : + x' = x ∧ y' = y ∧ z' = z := by + obtain ⟨-, hempty⟩ := mem_goodTriangles.1 ht + by_contra hne + have := mem_adjacentTriangles.2 ⟨ht', h, by simpa using hne⟩ + simp [hempty] at this + +/-- If every vertex lies in at most `R` triangles, then at most `3 * R` triangles share a vertex +with a given triangle. -/ +private lemma card_adjacentTriangles_le {R : ℝ} + (hX : ∀ v, #((triangles X Y Z).filter fun (x, _, _) ↦ x = v) ≤ R) + (hY : ∀ v, #((triangles X Y Z).filter fun (_, y, _) ↦ y = v) ≤ R) + (hZ : ∀ v, #((triangles X Y Z).filter fun (_, _, z) ↦ z = v) ≤ R) (x y z : G) : + #(adjacentTriangles X Y Z x y z) ≤ 3 * R := by + have h : adjacentTriangles X Y Z x y z ⊆ ((triangles X Y Z).filter fun (x', _, _) ↦ x' = x) ∪ + ((triangles X Y Z).filter fun (_, y', _) ↦ y' = y) ∪ + (triangles X Y Z).filter fun (_, _, z') ↦ z' = z := by + rintro ⟨x', y', z'⟩ + simp only [mem_adjacentTriangles, mem_union, mem_filter] + tauto + grw [card_le_card h, card_union_le, card_union_le] + push_cast + linarith [hX x, hY y, hZ z] + +/-- The good triangles form a multicolored sum-free family: if `(x, y, z)`, `(x', y', z')` and +`(x'', y'', z'')` are good, then `x + y' + z'' = 0` only when the three triangles coincide. -/ +private lemma isMulticoloredSumFree_goodTriangles : + IsMulticoloredSumFree (fun (⟨(x, _, _), _⟩ : goodTriangles X Y Z) ↦ x) + (fun ⟨(_, y, _), _⟩ ↦ y) fun ⟨(_, _, z), _⟩ ↦ z := by + rintro ⟨⟨x, y, z⟩, hs⟩ ⟨⟨x', y', z'⟩, ht⟩ ⟨⟨x'', y'', z''⟩, hu⟩ + obtain ⟨hx, hy, hz, hsum⟩ := mem_triangles.1 (goodTriangles_subset X Y Z hs) + obtain ⟨-, hy', -, -⟩ := mem_triangles.1 (goodTriangles_subset X Y Z ht) + obtain ⟨-, -, hz'', -⟩ := mem_triangles.1 (goodTriangles_subset X Y Z hu) + simp only [Subtype.mk.injEq, Prod.mk.injEq] + constructor + · intro h + obtain ⟨-, rfl, rfl⟩ := eq_of_mem_goodTriangles hs (mem_triangles.2 ⟨hx, hy', hz'', h⟩) + (Or.inl rfl) + obtain ⟨rfl, -, rfl⟩ := eq_of_mem_goodTriangles ht (goodTriangles_subset X Y Z hs) + (Or.inr (Or.inl rfl)) + obtain ⟨rfl, rfl, -⟩ := eq_of_mem_goodTriangles hu (goodTriangles_subset X Y Z hs) + (Or.inr (Or.inr rfl)) + simp + · rintro ⟨⟨rfl, rfl, rfl⟩, rfl, rfl, rfl⟩ + exact hsum + +end Good + +variable {p : ℕ} [Fact p.Prime] {V W ι : Type*} [AddCommGroup V] [Module (ZMod p) V] [Fintype V] + [DecidableEq V] [AddCommGroup W] [Module (ZMod p) W] [Fintype W] [DecidableEq W] + {X Y Z : Finset V} {x y z x' y' z' : V} + +omit [Fintype V] [DecidableEq V] in +/-- A multicolored sum-free family inside a subspace `U` has at most `Nat.card U ^ (1 - c p)` +members. -/ +private lemma IsMulticoloredSumFree.card_le_natCard_rpow [Finite V] [Fintype ι] {x y z : ι → V} + (h : IsMulticoloredSumFree x y z) {U : Submodule (ZMod p) V} (hx : ∀ i, x i ∈ U) + (hy : ∀ i, y i ∈ U) (hz : ∀ i, z i ∈ U) : + (Fintype.card ι : ℝ) ≤ Nat.card U ^ (1 - c p) := by + have := Fintype.ofFinite U + have hU : IsMulticoloredSumFree (fun i ↦ (⟨x i, hx i⟩ : U)) (fun i ↦ ⟨y i, hy i⟩) + fun i ↦ ⟨z i, hz i⟩ := by + intro i j k + simpa [Subtype.ext_iff] using h i j k + simpa [Nat.card_eq_fintype_card] using hU.card_le_card_rpow (p := p) + +omit [Fintype V] in +/-- The good triangles of sets inside a subspace `U` form a multicolored sum-free family in `U`, +so there are at most `Nat.card U ^ (1 - c p)` of them. -/ +private lemma card_goodTriangles_le [Finite V] (U : Submodule (ZMod p) V) (hX : ∀ x ∈ X, x ∈ U) + (hY : ∀ y ∈ Y, y ∈ U) (hZ : ∀ z ∈ Z, z ∈ U) : + (#(goodTriangles X Y Z) : ℝ) ≤ Nat.card U ^ (1 - c p) := by + rw [← Fintype.card_coe] + apply IsMulticoloredSumFree.card_le_natCard_rpow isMulticoloredSumFree_goodTriangles + · rintro ⟨⟨x, y, z⟩, ht⟩ + exact hX x (by simp_all) + · rintro ⟨⟨x, y, z⟩, ht⟩ + exact hY y (by simp_all) + · rintro ⟨⟨x, y, z⟩, ht⟩ + exact hZ z (by simp_all) + +/-- The arithmetic of Lemma 5 of Fox and Lovász: if `5 * ρ * N ≤ w ≤ 5 * p * ρ * N` and +`0 < ρ ≤ 1`, then `w ^ 2 * (1 + N / w) ^ (1 - c) ≤ 30 * p ^ 2 * ρ ^ (1 + c) * N ^ 2`. -/ +private lemma sq_mul_one_add_div_rpow_le {p ρ N w c : ℝ} (hρ₀ : 0 < ρ) (hρ₁ : ρ ≤ 1) (hN : 0 < N) + (hc₀ : 0 ≤ c) (hc₁ : c ≤ 1) (hw₁ : 5 * (ρ * N) ≤ w) (hw₂ : w ≤ p * (5 * (ρ * N))) : + w ^ 2 * (1 + N / w) ^ (1 - c) ≤ 30 * p ^ 2 * ρ ^ (1 + c) * N ^ 2 := by + have hw : 0 < w := lt_of_lt_of_le (by positivity) hw₁ + calc w ^ 2 * (1 + N / w) ^ (1 - c) + ≤ (p * (5 * (ρ * N))) ^ 2 * (6 / 5 / ρ) ^ (1 - c) := by + gcongr + grw [div_le_div_of_nonneg_left hN.le (by positivity) hw₁] + field_simp + linarith + _ = 25 * p ^ 2 * N ^ 2 * (6 / 5) ^ (1 - c) * (ρ ^ 2 / ρ ^ (1 - c)) := by + rw [Real.div_rpow (by norm_num) hρ₀.le] + ring + _ = 25 * p ^ 2 * N ^ 2 * (6 / 5) ^ (1 - c) * ρ ^ (1 + c) := by + rw [← Real.rpow_two ρ, ← Real.rpow_sub hρ₀] + ring_nf + _ ≤ 25 * p ^ 2 * N ^ 2 * (6 / 5) * ρ ^ (1 + c) := by + grw [Real.rpow_le_rpow_of_exponent_le (by norm_num : (1 : ℝ) ≤ 6 / 5) + (by linarith : 1 - c ≤ 1), Real.rpow_one] + _ = 30 * p ^ 2 * ρ ^ (1 + c) * N ^ 2 := by ring + +/-- **Jensen's inequality** for `t ↦ t ^ q` with `0 ≤ q ≤ 1`: a sum of `q`-th powers is at most the +number of terms times the `q`-th power of the mean. -/ +private lemma sum_rpow_le_card_mul_rpow {κ : Type*} (s : Finset κ) {f : κ → ℝ} + (hf : ∀ i ∈ s, 0 ≤ f i) {q : ℝ} (hq₀ : 0 ≤ q) (hq₁ : q ≤ 1) : + ∑ i ∈ s, f i ^ q ≤ #s * ((∑ i ∈ s, f i) / #s) ^ q := by + rcases s.eq_empty_or_nonempty with rfl | hs + · simp + have hs' : (0 : ℝ) < #s := by exact_mod_cast hs.card_pos + have := ConcaveOn.le_map_sum (Real.concaveOn_rpow hq₀ hq₁) (t := s) + (w := fun _ ↦ (#s : ℝ)⁻¹) (p := f) (fun _ _ ↦ by positivity) (by simp [hs'.ne']) hf + simp only [smul_eq_mul, ← mul_sum] at this + rwa [inv_mul_le_iff₀ hs', ← div_eq_inv_mul] at this + +section Count + +variable [Fintype (V →ₗ[ZMod p] W)] + +omit [Fintype V] [DecidableEq V] in +/-- The linear maps vanishing at linearly independent vectors `v 0, …, v (r - 1)` form a +proportion `#W ^ (-r)` of all linear maps. -/ +private lemma card_filter_forall_apply_eq_zero {r : ℕ} {v : Fin r → V} + (hv : LinearIndependent (ZMod p) v) : + (#{A : V →ₗ[ZMod p] W | ∀ i, A (v i) = 0} : ℝ) = + Fintype.card (V →ₗ[ZMod p] W) / Fintype.card W ^ r := by + have h := hv.natCard_mul_pow_eq_natCard (K := ZMod p) (W := W) + simp only [Nat.card_eq_fintype_card, Fintype.card_subtype] at h + rw [eq_div_iff (pow_pos (Nat.cast_pos.2 Fintype.card_pos) r).ne'] + exact_mod_cast h + +omit [Fintype V] [DecidableEq V] in +/-- The linear maps vanishing at a nonzero vector `v` form a proportion `1 / #W` of all linear +maps. -/ +private lemma card_filter_apply_eq_zero_of_ne_zero {v : V} (hv : v ≠ 0) : + (#{A : V →ₗ[ZMod p] W | A v = 0} : ℝ) = Fintype.card (V →ₗ[ZMod p] W) / Fintype.card W := by + rw [← pow_one (Fintype.card W : ℝ), ← card_filter_forall_apply_eq_zero + (linearIndependent_unique_iff.2 (by simpa using hv) : LinearIndependent (ZMod p) ![v])] + simp + +omit [Fintype V] [DecidableEq V] in +/-- The linear maps vanishing at linearly independent vectors `x` and `y` form a proportion +`#W ^ (-2)` of all linear maps. -/ +private lemma card_filter_apply_eq_zero_of_linearIndependent + (hli : LinearIndependent (ZMod p) ![x, y]) : + (#{A : V →ₗ[ZMod p] W | A x = 0 ∧ A y = 0} : ℝ) = + Fintype.card (V →ₗ[ZMod p] W) / Fintype.card W ^ 2 := by + rw [← card_filter_forall_apply_eq_zero hli] + simp [Fin.forall_fin_two] + +omit [Fintype V] [DecidableEq V] in +/-- If `x` and `y` are linearly independent and `u` lies outside their span, then the linear maps +vanishing at `u`, `x` and `y` form a proportion `#W ^ (-3)` of all linear maps. -/ +private lemma card_filter_apply_eq_zero_of_notMem_span {u : V} + (hli : LinearIndependent (ZMod p) ![x, y]) (hu : u ∉ span (ZMod p) {x, y}) : + (#{A : V →ₗ[ZMod p] W | A u = 0 ∧ A x = 0 ∧ A y = 0} : ℝ) = + Fintype.card (V →ₗ[ZMod p] W) / Fintype.card W ^ 3 := by + have hv : LinearIndependent (ZMod p) ![u, x, y] := + linearIndependent_finCons.2 ⟨hli, by rwa [Matrix.range_cons_cons_empty]⟩ + rw [← card_filter_forall_apply_eq_zero hv] + simp [Fin.forall_fin_succ] + +omit [Fintype V] [DecidableEq V] in +/-- If `x` and `y` are linearly independent and `x'` or `y'` lies outside their span, then the +linear maps vanishing at `x`, `y`, `x'` and `y'` form a proportion at most `#W ^ (-3)` of all +linear maps. -/ +private lemma card_filter_apply_eq_zero_le_of_not_and_mem_span + (hli : LinearIndependent (ZMod p) ![x, y]) + (h : ¬(x' ∈ span (ZMod p) {x, y} ∧ y' ∈ span (ZMod p) {x, y})) : + (#{A : V →ₗ[ZMod p] W | A x = 0 ∧ A y = 0 ∧ A x' = 0 ∧ A y' = 0} : ℝ) ≤ + Fintype.card (V →ₗ[ZMod p] W) / Fintype.card W ^ 3 := by + rcases not_and_or.1 h with h | h <;> + · rw [← card_filter_apply_eq_zero_of_notMem_span hli h] + exact_mod_cast card_le_card (monotone_filter_right _ fun A ↦ by tauto) + +omit [Fintype V] [Module (ZMod p) V] in +/-- If the span of the first two vertices of a triangle `(x, y, z)` contains the first two vertices +of no other triangle, then each triangle sharing a vertex with `(x, y, z)` has one of its first two +vertices outside that span. -/ +private lemma not_and_mem_span_of_mem_adjacentTriangles [Module (ZMod p) V] + (hspan : ∀ x y z, (x, y, z) ∈ triangles X Y Z → ∀ x' y' z', (x', y', z') ∈ triangles X Y Z → + x' ∈ span (ZMod p) {x, y} → y' ∈ span (ZMod p) {x, y} → x' = x ∧ y' = y) + (ht : (x, y, z) ∈ triangles X Y Z) (ht' : (x', y', z') ∈ adjacentTriangles X Y Z x y z) : + ¬(x' ∈ span (ZMod p) {x, y} ∧ y' ∈ span (ZMod p) {x, y}) := by + rintro ⟨hx', hy'⟩ + obtain ⟨ht'', -, hne⟩ := mem_adjacentTriangles.1 ht' + obtain ⟨rfl, rfl⟩ := hspan x y z ht x' y' z' ht'' hx' hy' + simp only [mem_triangles] at ht ht'' + grind + +omit [Fintype V] [Fintype W] in +/-- If a linear map `A` vanishes at the first two vertices of a triangle `(x, y, z)` that is not +good in the kernel of `A`, then `A` vanishes at the first two vertices of a triangle sharing a +vertex with `(x, y, z)`. -/ +private lemma filter_apply_eq_zero_subset [DecidableEq (V →ₗ[ZMod p] W)] + (ht : (x, y, z) ∈ triangles X Y Z) : + ({A : V →ₗ[ZMod p] W | A x = 0 ∧ A y = 0} : Finset _) ⊆ + ({A : V →ₗ[ZMod p] W | (x, y, z) ∈ + goodTriangles (X.filter (A · = 0)) (Y.filter (A · = 0)) (Z.filter (A · = 0))} : Finset _) ∪ + (adjacentTriangles X Y Z x y z).biUnion fun (x', y', _) ↦ + {A : V →ₗ[ZMod p] W | A x = 0 ∧ A y = 0 ∧ A x' = 0 ∧ A y' = 0} := by + intro A hA + obtain ⟨-, hAx, hAy⟩ := mem_filter.1 hA + obtain ⟨hx, hy, hz, hsum⟩ := mem_triangles.1 ht + have hAz : A z = 0 := by simpa [hAx, hAy] using congr(A $hsum) + rw [mem_union, or_iff_not_imp_left] + intro hgood + obtain ⟨⟨x', y', z'⟩, ht'⟩ := nonempty_iff_ne_empty.2 + (by simpa [hx, hy, hz, hsum, hAx, hAy, hAz] using hgood) + simp only [mem_biUnion, mem_filter, mem_univ, true_and] + refine ⟨(x', y', z'), adjacentTriangles_mono (filter_subset _ _) (filter_subset _ _) + (filter_subset _ _) ht', hAx, hAy, ?_⟩ + simp only [mem_adjacentTriangles, mem_triangles, mem_filter] at ht' + tauto + +omit [Fintype V] in +/-- A triangle `(x, y, z)` is good in the kernel of at least a proportion +`(1 - 3 * R / #W) / #W ^ 2` of the linear maps `A`: its first two vertices lie in the kernel with +probability `#W ^ (-2)`, and each of the at most `3 * R` triangles sharing a vertex with it lies in +the kernel as well with probability at most `#W ^ (-3)`. -/ +private lemma card_filter_mem_goodTriangles_ge {R : ℝ} + (hli : ∀ x y z, (x, y, z) ∈ triangles X Y Z → LinearIndependent (ZMod p) ![x, y]) + (hspan : ∀ x y z, (x, y, z) ∈ triangles X Y Z → ∀ x' y' z', (x', y', z') ∈ triangles X Y Z → + x' ∈ span (ZMod p) {x, y} → y' ∈ span (ZMod p) {x, y} → x' = x ∧ y' = y) + (hX : ∀ v, #((triangles X Y Z).filter fun (x, _, _) ↦ x = v) ≤ R) + (hY : ∀ v, #((triangles X Y Z).filter fun (_, y, _) ↦ y = v) ≤ R) + (hZ : ∀ v, #((triangles X Y Z).filter fun (_, _, z) ↦ z = v) ≤ R) + (ht : (x, y, z) ∈ triangles X Y Z) : + Fintype.card (V →ₗ[ZMod p] W) * (1 - 3 * R / Fintype.card W) / Fintype.card W ^ 2 ≤ + #{A : V →ₗ[ZMod p] W | (x, y, z) ∈ + goodTriangles (X.filter (A · = 0)) (Y.filter (A · = 0)) (Z.filter (A · = 0))} := by + classical + have h := card_le_card (filter_apply_eq_zero_subset (p := p) (W := W) ht) + grw [card_union_le, card_biUnion_le] at h + rw [← Nat.cast_le (α := ℝ), Nat.cast_add, Nat.cast_sum, + card_filter_apply_eq_zero_of_linearIndependent (hli x y z ht)] at h + grw [sum_le_card_nsmul _ _ (Fintype.card (V →ₗ[ZMod p] W) / Fintype.card W ^ 3 : ℝ), + nsmul_eq_mul, card_adjacentTriangles_le hX hY hZ] at h + · field_simp at h ⊢ + linarith + · rintro ⟨x', y', z'⟩ ht' + exact card_filter_apply_eq_zero_le_of_not_and_mem_span (hli x y z ht) + (not_and_mem_span_of_mem_adjacentTriangles hspan ht ht') + +omit [DecidableEq V] in +/-- The kernels of the linear maps `A : V →ₗ[ZMod p] W` have at most +`#(V →ₗ[ZMod p] W) * (1 + #V / #W)` elements in total: each nonzero vector lies in a proportion +`1 / #W` of the kernels. -/ +private lemma sum_card_ker_le : + ∑ A : V →ₗ[ZMod p] W, (#{v | A v = 0} : ℝ) ≤ + Fintype.card (V →ₗ[ZMod p] W) * (1 + Fintype.card V / Fintype.card W) := by + classical + rw [← Nat.cast_sum] + simp only [card_filter] + rw [sum_comm] + simp only [← card_filter] + rw [Nat.cast_sum, ← add_sum_erase _ _ (mem_univ 0)] + grw [sum_le_card_nsmul _ _ (Fintype.card (V →ₗ[ZMod p] W) / Fintype.card W : ℝ)] + · rw [card_erase_of_mem (mem_univ 0), card_univ, nsmul_eq_mul, + Nat.cast_pred Fintype.card_pos] + simp only [map_zero, filter_true, card_univ] + rw [mul_one_add, mul_div_left_comm] + gcongr + linarith + · intro v hv + rw [card_filter_apply_eq_zero_of_ne_zero (ne_of_mem_erase hv)] + +omit [Fintype W] [Fintype (V →ₗ[ZMod p] W)] in +/-- The good triangles in the kernel of `A` number at most `#(ker A) ^ (1 - c p)`. -/ +private lemma card_goodTriangles_filter_le (A : V →ₗ[ZMod p] W) : + (#(goodTriangles (X.filter (A · = 0)) (Y.filter (A · = 0)) (Z.filter (A · = 0))) : ℝ) ≤ + (#{v | A v = 0} : ℝ) ^ (1 - c p) := by + grw [card_goodTriangles_le (LinearMap.ker A) (fun x hx ↦ by simp_all) (fun y hy ↦ by simp_all) + fun z hz ↦ by simp_all] + simp [Nat.card_eq_fintype_card, ← Fintype.card_subtype] + +/-- Summing the bound of `card_goodTriangles_le` over the kernels of all linear maps `A`, with +Jensen's inequality for the average size of the kernels. -/ +private lemma sum_card_goodTriangles_le : + ∑ A : V →ₗ[ZMod p] W, + (#(goodTriangles (X.filter (A · = 0)) (Y.filter (A · = 0)) (Z.filter (A · = 0))) : ℝ) ≤ + Fintype.card (V →ₗ[ZMod p] W) * (1 + Fintype.card V / Fintype.card W) ^ (1 - c p) := by + have hp := (Fact.out : p.Prime).two_le + calc ∑ A : V →ₗ[ZMod p] W, + (#(goodTriangles (X.filter (A · = 0)) (Y.filter (A · = 0)) (Z.filter (A · = 0))) : ℝ) + ≤ ∑ A : V →ₗ[ZMod p] W, (#{v | A v = 0} : ℝ) ^ (1 - c p) := by + gcongr with A + exact card_goodTriangles_filter_le A + _ ≤ Fintype.card (V →ₗ[ZMod p] W) * + ((∑ A : V →ₗ[ZMod p] W, (#{v | A v = 0} : ℝ)) / Fintype.card (V →ₗ[ZMod p] W)) ^ + (1 - c p) := by + simpa using sum_rpow_le_card_mul_rpow univ (fun _ _ ↦ by positivity) + (by linarith [c_lt_one hp]) (by linarith [c_pos hp]) + _ ≤ Fintype.card (V →ₗ[ZMod p] W) * (1 + Fintype.card V / Fintype.card W) ^ (1 - c p) := by + grw [sum_card_ker_le, mul_div_cancel_left₀ _ (Nat.cast_pos.2 Fintype.card_pos).ne'] + linarith [c_lt_one hp] + +omit [Fintype V] [Fintype W] in +/-- Double counting the pairs `(t, A)` such that the triangle `t` is good in the kernel of `A`. -/ +private lemma sum_card_filter_mem_goodTriangles_eq : + ∑ t ∈ triangles X Y Z, #{A : V →ₗ[ZMod p] W | + t ∈ goodTriangles (X.filter (A · = 0)) (Y.filter (A · = 0)) (Z.filter (A · = 0))} = + ∑ A : V →ₗ[ZMod p] W, + #(goodTriangles (X.filter (A · = 0)) (Y.filter (A · = 0)) (Z.filter (A · = 0))) := by + simp only [card_filter] + rw [sum_comm] + congr with A + rw [← card_filter, filter_mem_eq_inter, inter_eq_right.2] + exact (goodTriangles_subset _ _ _).trans + (triangles_mono (filter_subset _ _) (filter_subset _ _) (filter_subset _ _)) + +omit [DecidableEq W] [Fintype (V →ₗ[ZMod p] W)] in +/-- Double counting the pairs `(t, A)` such that the triangle `t` is good in the kernel of `A` +bounds the number of triangles. -/ +private lemma card_triangles_mul_le {R : ℝ} + (hli : ∀ x y z, (x, y, z) ∈ triangles X Y Z → LinearIndependent (ZMod p) ![x, y]) + (hspan : ∀ x y z, (x, y, z) ∈ triangles X Y Z → ∀ x' y' z', (x', y', z') ∈ triangles X Y Z → + x' ∈ span (ZMod p) {x, y} → y' ∈ span (ZMod p) {x, y} → x' = x ∧ y' = y) + (hX : ∀ v, #((triangles X Y Z).filter fun (x, _, _) ↦ x = v) ≤ R) + (hY : ∀ v, #((triangles X Y Z).filter fun (_, y, _) ↦ y = v) ≤ R) + (hZ : ∀ v, #((triangles X Y Z).filter fun (_, _, z) ↦ z = v) ≤ R) : + #(triangles X Y Z) * (1 - 3 * R / Fintype.card W) ≤ + Fintype.card W ^ 2 * (1 + Fintype.card V / Fintype.card W) ^ (1 - c p) := by + have := Classical.decEq W + have := Fintype.ofFinite (V →ₗ[ZMod p] W) + have h := card_nsmul_le_sum (triangles X Y Z) (fun t ↦ (#{A : V →ₗ[ZMod p] W | + t ∈ goodTriangles (X.filter (A · = 0)) (Y.filter (A · = 0)) (Z.filter (A · = 0))} : ℝ)) _ + fun ⟨x, y, z⟩ ht ↦ card_filter_mem_goodTriangles_ge hli hspan hX hY hZ ht + rw [nsmul_eq_mul, ← Nat.cast_sum, sum_card_filter_mem_goodTriangles_eq, Nat.cast_sum] at h + grw [sum_card_goodTriangles_le] at h + rw [← mul_le_mul_iff_of_pos_left (by positivity : + (0 : ℝ) < Fintype.card (V →ₗ[ZMod p] W) / Fintype.card W ^ 2)] + convert h using 1 <;> field_simp + +omit [DecidableEq W] [Fintype (V →ₗ[ZMod p] W)] in +/-- If every vertex lies in at most `R` triangles and `5 * R ≤ #W`, then +`2 * #(triangles X Y Z) ≤ 5 * #W ^ 2 * (1 + #V / #W) ^ (1 - c p)`. -/ +private lemma two_mul_card_triangles_le {R : ℝ} + (hli : ∀ x y z, (x, y, z) ∈ triangles X Y Z → LinearIndependent (ZMod p) ![x, y]) + (hspan : ∀ x y z, (x, y, z) ∈ triangles X Y Z → ∀ x' y' z', (x', y', z') ∈ triangles X Y Z → + x' ∈ span (ZMod p) {x, y} → y' ∈ span (ZMod p) {x, y} → x' = x ∧ y' = y) + (hX : ∀ v, #((triangles X Y Z).filter fun (x, _, _) ↦ x = v) ≤ R) + (hY : ∀ v, #((triangles X Y Z).filter fun (_, y, _) ↦ y = v) ≤ R) + (hZ : ∀ v, #((triangles X Y Z).filter fun (_, _, z) ↦ z = v) ≤ R) + (hR : 5 * R ≤ Fintype.card W) : + (2 : ℝ) * #(triangles X Y Z) ≤ + 5 * Fintype.card W ^ 2 * (1 + Fintype.card V / Fintype.card W) ^ (1 - c p) := by + have h := card_triangles_mul_le (W := W) hli hspan hX hY hZ + have hR' : (2 / 5 : ℝ) ≤ 1 - 3 * R / Fintype.card W := by + rw [le_sub_comm, div_le_iff₀ (Nat.cast_pos.2 Fintype.card_pos)] + linarith + grw [← hR'] at h + linarith + +end Count + +/-- Lemma 5 of Fox and Lovász for `ρ ≤ 1`, given `p ^ n ≤ 5 * ρ * #V < p ^ (n + 1)`. The proof +samples linear maps to `Fin (n + 1) → ZMod p`. -/ +private lemma card_triangles_le_of_degree_le_of_pow_le {ρ : ℝ} {n : ℕ} + (hli : ∀ x y z, (x, y, z) ∈ triangles X Y Z → LinearIndependent (ZMod p) ![x, y]) + (hspan : ∀ x y z, (x, y, z) ∈ triangles X Y Z → ∀ x' y' z', (x', y', z') ∈ triangles X Y Z → + x' ∈ span (ZMod p) {x, y} → y' ∈ span (ZMod p) {x, y} → x' = x ∧ y' = y) + (hX : ∀ v, #((triangles X Y Z).filter fun (x, _, _) ↦ x = v) ≤ ρ * Fintype.card V) + (hY : ∀ v, #((triangles X Y Z).filter fun (_, y, _) ↦ y = v) ≤ ρ * Fintype.card V) + (hZ : ∀ v, #((triangles X Y Z).filter fun (_, _, z) ↦ z = v) ≤ ρ * Fintype.card V) + (hρ₀ : 0 < ρ) (hρ₁ : ρ ≤ 1) (hn₁ : p ^ n ≤ 5 * (ρ * Fintype.card V)) + (hn₂ : 5 * (ρ * Fintype.card V) < p ^ (n + 1)) : + #(triangles X Y Z) ≤ 125 * p ^ 2 * ρ ^ (1 + c p) * Fintype.card V ^ 2 := by + have hp := (Fact.out : p.Prime).two_le + have hw : (p : ℝ) ^ (n + 1) ≤ p * (5 * (ρ * Fintype.card V)) := by + rw [pow_succ'] + gcongr + have h := two_mul_card_triangles_le (W := Fin (n + 1) → ZMod p) hli hspan hX hY hZ + (by simpa using hn₂.le) + simp only [Fintype.card_fun, ZMod.card, Fintype.card_fin, Nat.cast_pow] at h + linarith [sq_mul_one_add_div_rpow_le hρ₀ hρ₁ (by positivity) (c_pos hp).le (c_lt_one hp).le + hn₂.le hw, (by positivity : 0 ≤ (p : ℝ) ^ 2 * ρ ^ (1 + c p) * Fintype.card V ^ 2)] + +/-- **Lemma 5 of Fox and Lovász.** Let `X`, `Y` and `Z` be sets in a finite vector space `V` over +`ZMod p` such that the first two vertices of each triangle are linearly independent and their span +contains the first two vertices of no other triangle. If every vertex lies in at most `ρ * #V` +triangles, then there are at most `125 * p ^ 2 * ρ ^ (1 + c p) * #V ^ 2` triangles. -/ +lemma card_triangles_le_of_degree_le {ρ : ℝ} + (hli : ∀ x y z, (x, y, z) ∈ triangles X Y Z → LinearIndependent (ZMod p) ![x, y]) + (hspan : ∀ x y z, (x, y, z) ∈ triangles X Y Z → ∀ x' y' z', (x', y', z') ∈ triangles X Y Z → + x' ∈ span (ZMod p) {x, y} → y' ∈ span (ZMod p) {x, y} → x' = x ∧ y' = y) + (hX : ∀ v, #((triangles X Y Z).filter fun (x, _, _) ↦ x = v) ≤ ρ * Fintype.card V) + (hY : ∀ v, #((triangles X Y Z).filter fun (_, y, _) ↦ y = v) ≤ ρ * Fintype.card V) + (hZ : ∀ v, #((triangles X Y Z).filter fun (_, _, z) ↦ z = v) ≤ ρ * Fintype.card V) : + #(triangles X Y Z) ≤ 125 * p ^ 2 * ρ ^ (1 + c p) * Fintype.card V ^ 2 := by + have hp : (2 : ℝ) ≤ p := by exact_mod_cast (Fact.out : p.Prime).two_le + have hN : (0 : ℝ) < Fintype.card V := Nat.cast_pos.2 Fintype.card_pos + obtain hT | ⟨⟨x, y, z⟩, ht⟩ := (triangles X Y Z).eq_empty_or_nonempty + · have : 0 ≤ ρ := nonneg_of_mul_nonneg_left ((Nat.cast_nonneg _).trans (hX 0)) hN + rw [hT, card_empty, Nat.cast_zero] + positivity + have hρN : 1 ≤ ρ * Fintype.card V := + (hX x).trans' (Nat.one_le_cast.2 (card_pos.2 ⟨_, mem_filter.2 ⟨ht, rfl⟩⟩)) + obtain hρ | hρ := le_or_gt 1 ρ + · grw [card_triangles_le_card_sq] + push_cast + exact le_mul_of_one_le_left (by positivity) (one_le_mul_of_one_le_of_one_le (by nlinarith) + (Real.one_le_rpow hρ (by linarith [c_pos (p := p) (by exact_mod_cast hp)]))) + obtain ⟨n, hn₁, hn₂⟩ := exists_nat_pow_near (by linarith : 1 ≤ 5 * (ρ * Fintype.card V)) + (by linarith : (1 : ℝ) < p) + exact card_triangles_le_of_degree_le_of_pow_le hli hspan hX hY hZ + (pos_of_mul_pos_left (one_pos.trans_le hρN) hN.le) hρ.le hn₁ hn₂ + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/TensorPower.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/TensorPower.lean new file mode 100644 index 0000000000..198b2135ec --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/DisjointTriangles/TensorPower.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Exponent +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Triangle.Basic +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.DisjointTriangles.Embedding +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.DisjointTriangles.Pruning +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.TensorPower +import Mathlib.Tactic.Positivity.Finset + +/-! +# Many triangles from disjoint triangles + +This file proves Theorem 3 of Fox and Lovász: if `X × Y × Z` contains `m` vertex-disjoint +triangles in a finite vector space `V` over `ZMod p`, then it contains at least +`(m / #V) ^ C p * #V ^ 2` triangles. The pruning bound gives this up to a constant factor. The +`k`-th coordinatewise powers of `X`, `Y` and `Z` contain `m ^ k` vertex-disjoint triangles and +`D ^ k` triangles in a space of size `#V ^ k`, and letting `k` grow removes the constant factor. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.rpow_le_mul_card_pow_rpow_mul_card_triangles_pow_rpow`: + the pruning bound for the `k`-th coordinatewise powers of `X`, `Y` and `Z`. +* `ArithmeticTriangleRemovalInVectorSpaces.card_rpow_le_card_rpow_mul_card_triangles_rpow`: the + bound `m ^ (1 + c p) ≤ #V ^ (1 - c p) * D ^ c p`. +* `ArithmeticTriangleRemovalInVectorSpaces.div_rpow_C_mul_sq_le_card_triangles`: Theorem 3 of Fox + and Lovász. +-/ + +public section + +open Finset Function + +namespace ArithmeticTriangleRemovalInVectorSpaces + +/-- If `m ^ (1 + c) ≤ N ^ (1 - c) * D ^ c`, then `(m / N) ^ (1 + 1 / c) * N ^ 2 ≤ D`. -/ +private lemma div_rpow_one_add_one_div_mul_sq_le {m N D c : ℝ} (hc : 0 < c) (hm : 0 ≤ m) + (hN : 0 < N) (hD : 0 ≤ D) (h : m ^ (1 + c) ≤ N ^ (1 - c) * D ^ c) : + (m / N) ^ (1 + 1 / c) * N ^ 2 ≤ D := by + have h' := Real.rpow_le_rpow (by positivity) h (by positivity : 0 ≤ 1 / c) + rw [← Real.rpow_mul hm, Real.mul_rpow (by positivity) (by positivity), ← Real.rpow_mul hN.le, + ← Real.rpow_mul hD, mul_one_div_cancel hc.ne', Real.rpow_one, + (by grind : (1 + c) * (1 / c) = 1 + 1 / c), (by grind : (1 - c) * (1 / c) = 1 / c - 1), + Real.rpow_sub hN, Real.rpow_one] at h' + rw [Real.div_rpow hm hN.le, Real.rpow_add hN, Real.rpow_one] + field_simp at h' ⊢ + linarith + +variable {p : ℕ} [Fact p.Prime] {V ι : Type*} [AddCommGroup V] [Module (ZMod p) V] [Fintype V] + [DecidableEq V] [Fintype ι] {x y z : ι → V} {X Y Z : Finset V} + +/-- The pruning bound for the `k`-th coordinatewise powers of `X`, `Y` and `Z`, which contain the +`m ^ k` vertex-disjoint triangles `(x ∘ I, y ∘ I, z ∘ I)` and `D ^ k` triangles in a space of size +`#V ^ k`. -/ +private lemma rpow_le_mul_card_pow_rpow_mul_card_triangles_pow_rpow (hx : Injective x) + (hy : Injective y) + (hz : Injective z) (hxX : ∀ i, x i ∈ X) (hyY : ∀ i, y i ∈ Y) (hzZ : ∀ i, z i ∈ Z) + (hsum : ∀ i, x i + y i + z i = 0) (k : ℕ) : + (c p / (1 + c p) * Fintype.card ι ^ k / 2) ^ (1 + c p) ≤ + 125 * p ^ 2 * (p ^ 2 * Fintype.card V ^ k) ^ (1 - c p) * (#(triangles X Y Z) ^ k) ^ c p := by + have h := rpow_le_mul_card_rpow_mul_card_triangles_rpow (p := p) + (X := Fintype.piFinset fun _ : Fin k ↦ X) (Y := Fintype.piFinset fun _ ↦ Y) + (Z := Fintype.piFinset fun _ ↦ Z) hx.comp_left hy.comp_left hz.comp_left + (fun I ↦ Fintype.mem_piFinset.2 fun t ↦ hxX (I t)) + (fun I ↦ Fintype.mem_piFinset.2 fun t ↦ hyY (I t)) + (fun I ↦ Fintype.mem_piFinset.2 fun t ↦ hzZ (I t)) (fun I ↦ funext fun t ↦ hsum (I t)) + rw [card_triangles_piFinset, Fintype.card_fun, Fintype.card_fun, Fintype.card_fin] at h + exact_mod_cast h + +/-- If `X × Y × Z` contains `m` vertex-disjoint triangles `(x i, y i, z i)` and `D` triangles in +total, then `m ^ (1 + c p) ≤ #V ^ (1 - c p) * D ^ c p`. -/ +private lemma card_rpow_le_card_rpow_mul_card_triangles_rpow (hx : Injective x) (hy : Injective y) + (hz : Injective z) (hxX : ∀ i, x i ∈ X) (hyY : ∀ i, y i ∈ Y) (hzZ : ∀ i, z i ∈ Z) + (hsum : ∀ i, x i + y i + z i = 0) : + (Fintype.card ι : ℝ) ^ (1 + c p) ≤ + Fintype.card V ^ (1 - c p) * #(triangles X Y Z) ^ c p := by + have hc := c_pos (Fact.out : p.Prime).two_le + rcases isEmpty_or_nonempty ι with hι | hι + · simp only [Fintype.card_eq_zero, Nat.cast_zero, Real.zero_rpow (by linarith : 1 + c p ≠ 0)] + positivity + have hD := card_triangles_pos hxX hyY hzZ hsum + refine le_of_forall_pow_le_mul_pow (M := 125 * p ^ 2 * ((p : ℝ) ^ 2) ^ (1 - c p) / + (c p / (1 + c p) / 2) ^ (1 + c p)) (by positivity) ?_ + intro k + have h := rpow_le_mul_card_pow_rpow_mul_card_triangles_pow_rpow (p := p) hx hy hz hxX hyY hzZ + hsum k + rw [mul_div_right_comm, Real.mul_rpow (by positivity) (by positivity), + Real.mul_rpow (by positivity) (by positivity), + ← Real.rpow_pow_comm (Nat.cast_nonneg (Fintype.card ι)), + ← Real.rpow_pow_comm (Nat.cast_nonneg (Fintype.card V)), + ← Real.rpow_pow_comm (Nat.cast_nonneg #(triangles X Y Z))] at h + rw [div_mul_eq_mul_div, le_div_iff₀ (by positivity), mul_pow] + linarith + +/-- **Theorem 3 of Fox and Lovász.** If `X × Y × Z` contains `m` vertex-disjoint triangles +`(x i, y i, z i)` in a finite vector space `V` over `ZMod p`, then it contains at least +`(m / #V) ^ C p * #V ^ 2` triangles. -/ +lemma div_rpow_C_mul_sq_le_card_triangles (hx : Injective x) (hy : Injective y) + (hz : Injective z) (hxX : ∀ i, x i ∈ X) (hyY : ∀ i, y i ∈ Y) (hzZ : ∀ i, z i ∈ Z) + (hsum : ∀ i, x i + y i + z i = 0) : + ((Fintype.card ι : ℝ) / Fintype.card V) ^ C p * Fintype.card V ^ 2 ≤ #(triangles X Y Z) := + div_rpow_one_add_one_div_mul_sq_le (c_pos (Fact.out : p.Prime).two_le) (Nat.cast_nonneg _) + (Nat.cast_pos.2 Fintype.card_pos) (Nat.cast_nonneg _) + (card_rpow_le_card_rpow_mul_card_triangles_rpow hx hy hz hxX hyY hzZ hsum) + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Imports.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Imports.lean new file mode 100644 index 0000000000..730565f968 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Imports.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Lean Pool contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Lean Pool contributors +-/ +module -- shake: keep-all --deprecated_module: ignore + +-- Generated project imports; run `lake exe mk_all`. +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Construction.Behrend +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Construction.Family +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Construction.Hash +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Construction.LowerBound +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Construction.TypeClass +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Coupling.Basic +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Coupling.Decomposition +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Coupling.Decreasing +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Coupling.Peeling +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Coupling.Uniform +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.DisjointTriangles.Embedding +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.DisjointTriangles.MaximalFamily +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.DisjointTriangles.Pruning +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.DisjointTriangles.Sampling +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.DisjointTriangles.TensorPower +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.LinearMap.Card +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Basic +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Exponent +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Monomials +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Product +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.SliceRank +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.SmallPrimes +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.TensorPower +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.SliceRank.Diagonal +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Tightness.Exponent +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Triangle.Basic +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.ZMod diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/LinearMap/Card.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/LinearMap/Card.lean new file mode 100644 index 0000000000..1e19bdd20d --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/LinearMap/Card.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import Mathlib.LinearAlgebra.LinearIndependent.Defs +public import Mathlib.SetTheory.Cardinal.Finite +import Mathlib.GroupTheory.Index +import Mathlib.LinearAlgebra.Basis.VectorSpace + +/-! +# Linear maps vanishing at independent vectors + +For linearly independent `v : Fin r → V`, the map `A ↦ (A (v i))ᵢ` from `V →ₗ[K] W` to +`Fin r → W` is surjective. Hence the linear maps that vanish at `v 0, …, v (r - 1)` form a +proportion `1 / Nat.card W ^ r` of all linear maps. A uniformly random linear map `A` stands in for +the random subspace of Fox and Lovász: its kernel contains `r` given independent vectors with +probability `Nat.card W ^ (-r)`. + +## Main statements + +* `LinearMap.finite_of_finite`: there are finitely many linear maps between finite modules. +* `LinearIndependent.exists_linearMap_apply_eq`: prescribing the values of a linear map at + linearly independent vectors. +* `LinearIndependent.surjective_pi_applyₗ`: the map `A ↦ (A (v i))ᵢ` is surjective. +* `LinearIndependent.natCard_mul_pow_eq_natCard`: the count of linear maps vanishing at `r` + linearly independent vectors. +-/ + +public section + +open Module + +variable {K V W : Type*} [Field K] [AddCommGroup V] [Module K V] [AddCommGroup W] [Module K W] + {r : ℕ} {v : Fin r → V} + +/-- There are finitely many linear maps between finite modules. -/ +instance LinearMap.finite_of_finite [Finite V] [Finite W] : Finite (V →ₗ[K] W) := + Finite.of_injective _ DFunLike.coe_injective + +/-- A linear map can take any prescribed values at linearly independent vectors. -/ +private lemma LinearIndependent.exists_linearMap_apply_eq (hv : LinearIndependent K v) + (w : Fin r → W) : ∃ A : V →ₗ[K] W, ∀ i, A (v i) = w i := by + obtain ⟨A, hA⟩ := LinearMap.exists_extend ((Basis.span hv).constr K w) + use A + intro i + simpa [Finsupp.single_apply] using congr($hA (Basis.span hv i)) + +/-- For linearly independent `v`, the map `A ↦ (A (v i))ᵢ` is surjective. -/ +private lemma LinearIndependent.surjective_pi_applyₗ (hv : LinearIndependent K v) : + Function.Surjective + (LinearMap.pi fun i ↦ LinearMap.applyₗ (v i) : (V →ₗ[K] W) →ₗ[K] Fin r → W) := by + intro w + obtain ⟨A, hA⟩ := hv.exists_linearMap_apply_eq w + exact ⟨A, funext hA⟩ + +/-- The linear maps vanishing at `r` linearly independent vectors form a proportion +`1 / Nat.card W ^ r` of all linear maps. -/ +lemma LinearIndependent.natCard_mul_pow_eq_natCard (hv : LinearIndependent K v) : + Nat.card {A : V →ₗ[K] W // ∀ i, A (v i) = 0} * Nat.card W ^ r = Nat.card (V →ₗ[K] W) := by + convert AddSubgroup.card_ker_mul_card_of_surjective (f := (LinearMap.pi fun i ↦ + LinearMap.applyₗ (v i) : (V →ₗ[K] W) →ₗ[K] Fin r → W).toAddMonoidHom) hv.surjective_pi_applyₗ + using 2 + · exact Nat.card_congr (Equiv.subtypeEquivRight fun A ↦ by simp [funext_iff]) + · rw [Nat.card_fun, Nat.card_fin] diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Basic.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Basic.lean new file mode 100644 index 0000000000..d8900f851b --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Basic.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import Mathlib.Algebra.Group.Hom.Defs +public import Mathlib.Algebra.Group.Pi.Basic + +/-! +# Multicolored sum-free families + +A family of triples `(x i, y i, z i)` in an abelian group is multicolored sum-free if +`x i + y j + z k = 0` holds exactly when `i = j = k`. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.IsMulticoloredSumFree x y z`: the family of triples + `(x i, y i, z i)` is multicolored sum-free. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.IsMulticoloredSumFree.pi`: the coordinatewise power of a + multicolored sum-free family, indexed by `κ → ι`, is multicolored sum-free. +* `ArithmeticTriangleRemovalInVectorSpaces.IsMulticoloredSumFree.map`: the image of a multicolored + sum-free family under an injective additive map is multicolored sum-free. +* `ArithmeticTriangleRemovalInVectorSpaces.IsMulticoloredSumFree.comp`: a subfamily of a + multicolored sum-free family is multicolored sum-free. +-/ + +@[expose] public section + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {ι G H : Type*} [AddCommGroup G] [AddCommGroup H] + +/-- A family of triples `(x i, y i, z i)` is multicolored sum-free if `x i + y j + z k = 0` holds +exactly when `i = j = k`. -/ +def IsMulticoloredSumFree (x y z : ι → G) : Prop := + ∀ i j k, x i + y j + z k = 0 ↔ i = j ∧ j = k + +namespace IsMulticoloredSumFree + +variable {x y z : ι → G} + +/-- The coordinatewise power of a multicolored sum-free family is multicolored sum-free. -/ +lemma pi (h : IsMulticoloredSumFree x y z) (κ : Type*) : + IsMulticoloredSumFree (fun (I : κ → ι) t ↦ x (I t)) (fun I t ↦ y (I t)) fun I t ↦ z (I t) := by + intro I J K + simp only [funext_iff, Pi.add_apply, Pi.zero_apply, h _ _ _] + grind + +/-- The image of a multicolored sum-free family under an injective additive map is multicolored +sum-free. -/ +lemma map (h : IsMulticoloredSumFree x y z) (e : G →+ H) (he : Function.Injective e) : + IsMulticoloredSumFree (e ∘ x) (e ∘ y) (e ∘ z) := by + intro i j k + rw [← h, Function.comp_apply, Function.comp_apply, Function.comp_apply, ← map_add, ← map_add, + ← e.map_zero, he.eq_iff] + +/-- A subfamily of a multicolored sum-free family, indexed through an injective map, is +multicolored sum-free. -/ +lemma comp {κ : Type*} (h : IsMulticoloredSumFree x y z) {f : κ → ι} (hf : Function.Injective f) : + IsMulticoloredSumFree (x ∘ f) (y ∘ f) (z ∘ f) := by + intro i j k + rw [Function.comp_apply, Function.comp_apply, Function.comp_apply, h, hf.eq_iff, hf.eq_iff] + +end IsMulticoloredSumFree + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Exponent.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Exponent.lean new file mode 100644 index 0000000000..aff70f7df7 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Exponent.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import Mathlib.Analysis.SpecialFunctions.Log.Base +import Mathlib.Analysis.Calculus.Deriv.Pow +import Mathlib.Analysis.Convex.SpecificFunctions.Basic +import Mathlib.Analysis.SpecialFunctions.Pow.Deriv + +/-! +# The exponents `c p` and `C p`, and the thresholds of Theorem 1 + +The exponent `c p` of Kleinberg, Sawin and Speyer is defined by +`p ^ (1 - c p) = ⨅ x : Set.Ioo 0 1, x ^ (-(p - 1) / 3) * ∑ j ∈ range p, x ^ j`. A multicolored +sum-free family in `Fin n → ZMod p` has at most `p ^ ((1 - c p) * n)` members, and the exponent of +the arithmetic triangle removal lemma in `Fin n → ZMod p` is `C p = 1 + 1 / c p`. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.c p`: the exponent `c p`. +* `ArithmeticTriangleRemovalInVectorSpaces.C p`: the exponent `C p = 1 + 1 / c p`. +* `ArithmeticTriangleRemovalInVectorSpaces.n₀ p η`: the dimension from which on there are + multicolored sum-free families with at least `p ^ ((1 - c p - η) * n)` members. +* `ArithmeticTriangleRemovalInVectorSpaces.ε₀ p η`: the bound below which `δ ≤ ε ^ (C p - η)` in + the arithmetic triangle removal lemma. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.rpow_one_sub_c_le`: `p ^ (1 - c p)` is at most the + value of `x ^ (-(p - 1) / 3) * ∑ j ∈ range p, x ^ j` at each `x ∈ Set.Ioo 0 1`. +* `ArithmeticTriangleRemovalInVectorSpaces.le_rpow_one_sub_c`: it is the largest such number. +* `ArithmeticTriangleRemovalInVectorSpaces.c_pos` and + `ArithmeticTriangleRemovalInVectorSpaces.c_lt_one`: `0 < c p` and `c p < 1` for `2 ≤ p`. +-/ + +@[expose] public section + +open Finset Filter Topology + +namespace ArithmeticTriangleRemovalInVectorSpaces + +/-- The exponent `c p` of Kleinberg, Sawin and Speyer, defined by +`p ^ (1 - c p) = ⨅ x : Set.Ioo 0 1, x ^ (-(p - 1) / 3) * ∑ j ∈ range p, x ^ j`. -/ +noncomputable def c (p : ℕ) : ℝ := + 1 - Real.logb p + (⨅ x : Set.Ioo (0 : ℝ) 1, (x : ℝ) ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, (x : ℝ) ^ j) + +/-- The exponent `C p = 1 + 1 / c p` of the arithmetic triangle removal lemma in +`Fin n → ZMod p`. -/ +noncomputable def C (p : ℕ) : ℝ := + 1 + 1 / c p + +/-- The dimension `n₀ p η = ⌈(2 ^ (p + 3) * p ^ 10 / η) ^ 2⌉ + p ^ 4 + 1` from which on +`Fin n → ZMod p` contains a multicolored sum-free family with at least `p ^ ((1 - c p - η) * n)` +members. -/ +noncomputable def n₀ (p : ℕ) (η : ℝ) : ℕ := + ⌈(2 ^ (p + 3) * p ^ 10 / η) ^ 2⌉₊ + p ^ 4 + 1 + +/-- The bound `ε₀ p η = p ^ (-(n₀ p η' + 1))` with `η' = c p * min (1 - c p) (c p * η / 2) / 2`. +For `0 < ε < ε₀ p η`, every `δ` that works with `ε` in the arithmetic triangle removal lemma in +`Fin n → ZMod p` for every `n` satisfies `δ ≤ ε ^ (C p - η)`. -/ +noncomputable def ε₀ (p : ℕ) (η : ℝ) : ℝ := + ((p : ℝ) ^ (n₀ p (c p * min (1 - c p) (c p * η / 2) / 2) + 1))⁻¹ + +lemma pow_four_lt_n₀ (p : ℕ) (η : ℝ) : p ^ 4 < n₀ p η := by + grind [n₀] + +lemma sq_add_one_le_n₀ (p : ℕ) (η : ℝ) : (2 ^ (p + 3) * p ^ 10 / η) ^ 2 + 1 ≤ n₀ p η := by + rw [n₀] + push_cast + gcongr ?_ + 1 + exact (Nat.le_ceil _).trans (le_add_of_nonneg_right (by positivity)) + +variable {p : ℕ} + +/-- For `0 < x < 1` and `2 ≤ p`, `3 / 2 ≤ x ^ (-(p - 1) / 3) * ∑ j ∈ range p, x ^ j`. -/ +lemma three_div_two_le_rpow_mul_sum (hp : 2 ≤ p) {x : ℝ} (hx₀ : 0 < x) (hx₁ : x < 1) : + 3 / 2 ≤ x ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, x ^ j := by + have hroot : x ^ (1 / 3 : ℝ) ≤ 1 + 1 / 3 * (x - 1) := by + simpa using rpow_one_add_le_one_add_mul_self (by linarith : -1 ≤ x - 1) + (by norm_num : (0 : ℝ) ≤ 1 / 3) (by norm_num) + have hneg : 3 / (2 + x) ≤ x ^ (-((p : ℝ) - 1) / 3) := by + grw [← Real.rpow_le_rpow_of_exponent_ge hx₀ hx₁.le + (by linarith [(Nat.ofNat_le_cast.2 hp : (2 : ℝ) ≤ p)] : -((p : ℝ) - 1) / 3 ≤ -(1 / 3))] + rw [Real.rpow_neg hx₀.le, div_le_iff₀ (by positivity), ← div_eq_inv_mul, + le_div_iff₀ (by positivity)] + linarith + have hsum : 1 + x ≤ ∑ j ∈ range p, x ^ j := by + grw [← sum_le_sum_of_subset_of_nonneg (range_subset_range.2 hp) fun j _ _ ↦ by positivity] + simp [add_comm] + grw [← hneg, ← hsum] + rw [div_mul_eq_mul_div, le_div_iff₀ (by positivity)] + linarith + +/-- The value of the infimum defining `c p`. -/ +private lemma rpow_one_sub_c (hp : 2 ≤ p) : + (p : ℝ) ^ (1 - c p) = + ⨅ x : Set.Ioo (0 : ℝ) 1, (x : ℝ) ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, (x : ℝ) ^ j := by + have : Nonempty (Set.Ioo (0 : ℝ) 1) := ⟨⟨1 / 2, by norm_num, by norm_num⟩⟩ + rw [c, sub_sub_cancel, Real.rpow_logb (by positivity) + (by exact_mod_cast (by grind : p ≠ 1))] + refine lt_of_lt_of_le (by norm_num : (0 : ℝ) < 3 / 2) (le_ciInf ?_) + rintro ⟨x, hx₀, hx₁⟩ + exact three_div_two_le_rpow_mul_sum hp hx₀ hx₁ + +/-- `p ^ (1 - c p)` is at most `x ^ (-(p - 1) / 3) * ∑ j ∈ range p, x ^ j` for `0 < x < 1`. -/ +lemma rpow_one_sub_c_le (hp : 2 ≤ p) {x : ℝ} (hx₀ : 0 < x) (hx₁ : x < 1) : + (p : ℝ) ^ (1 - c p) ≤ x ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, x ^ j := by + rw [rpow_one_sub_c hp] + refine ciInf_le ⟨0, ?_⟩ (⟨x, hx₀, hx₁⟩ : Set.Ioo (0 : ℝ) 1) + rintro _ ⟨⟨y, hy₀, -⟩, rfl⟩ + positivity + +/-- `p ^ (1 - c p)` is the largest lower bound of `x ^ (-(p - 1) / 3) * ∑ j ∈ range p, x ^ j` on +`Set.Ioo 0 1`. -/ +lemma le_rpow_one_sub_c (hp : 2 ≤ p) {b : ℝ} + (h : ∀ x : ℝ, 0 < x → x < 1 → b ≤ x ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, x ^ j) : + b ≤ (p : ℝ) ^ (1 - c p) := by + have : Nonempty (Set.Ioo (0 : ℝ) 1) := ⟨⟨1 / 2, by norm_num, by norm_num⟩⟩ + rw [rpow_one_sub_c hp] + apply le_ciInf + rintro ⟨x, hx₀, hx₁⟩ + exact h x hx₀ hx₁ + +/-- The function `fun x ↦ x ^ (-(p - 1) / 3) * ∑ j ∈ range p, x ^ j` takes a value smaller than +`p` on `Set.Ioo 0 1`: its value at `1` is `p` and its derivative there is `p * (p - 1) / 6`, which +is positive. -/ +private lemma exists_rpow_mul_sum_lt (hp : 2 ≤ p) : + ∃ x : ℝ, 0 < x ∧ x < 1 ∧ x ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, x ^ j < p := by + have hderiv : HasDerivAt (fun x : ℝ ↦ x ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, x ^ j) + (p * (p - 1) / 6) 1 := by + have h := sum_range_id_mul_two p + rw [← Nat.cast_inj (R := ℝ)] at h + push_cast [Nat.cast_sub (by grind : 1 ≤ p)] at h + convert (Real.hasDerivAt_rpow_const (p := -((p : ℝ) - 1) / 3) (Or.inl one_ne_zero)).fun_mul + (HasDerivAt.fun_sum fun j (_ : j ∈ range p) ↦ hasDerivAt_pow j (1 : ℝ)) using 1 + simp + linarith + have hslope := (hasDerivAt_iff_tendsto_slope.1 hderiv).mono_left + (nhdsWithin_mono _ fun y (hy : y ∈ Set.Iio 1) ↦ hy.ne) + obtain ⟨x, hslope, hx₀, hx₁⟩ := ((hslope.eventually (lt_mem_nhds + (by nlinarith [(Nat.ofNat_le_cast.2 hp : (2 : ℝ) ≤ p)] : (0 : ℝ) < p * (p - 1) / 6))).and + (Ioo_mem_nhdsLT one_pos)).exists + refine ⟨x, hx₀, hx₁, ?_⟩ + rw [slope_def_field, lt_div_iff_of_neg (by linarith), zero_mul, sub_neg] at hslope + simpa using hslope + +/-- The exponent `c p` is positive. -/ +lemma c_pos (hp : 2 ≤ p) : 0 < c p := by + obtain ⟨x, hx₀, hx₁, hx⟩ := exists_rpow_mul_sum_lt hp + by_contra! hc + have := Real.self_le_rpow_of_one_le (Nat.one_le_cast.2 (by grind) : (1 : ℝ) ≤ p) + (by linarith : 1 ≤ 1 - c p) + linarith [rpow_one_sub_c_le hp hx₀ hx₁] + +/-- The exponent `c p` is less than one. -/ +lemma c_lt_one (hp : 2 ≤ p) : c p < 1 := by + by_contra! hc + linarith [le_rpow_one_sub_c hp fun _ ↦ three_div_two_le_rpow_mul_sum hp, + Real.rpow_le_one_of_one_le_of_nonpos (Nat.one_le_cast.2 (by grind) : (1 : ℝ) ≤ p) + (by linarith : 1 - c p ≤ 0)] + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Monomials.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Monomials.lean new file mode 100644 index 0000000000..d57f17a6bc --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Monomials.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import Mathlib.Analysis.SpecialFunctions.Pow.Real + +/-! +# Monomials of low degree + +The polynomial method bounds a multicolored sum-free family in `Fin d → ZMod p` by three times the +number of monomials in `d` variables of degree at most `(p - 1) * d / 3` in which each variable has +degree less than `p`. This file defines the set of their exponent vectors and bounds its size by a +Chernoff bound. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.lowDegreeExponents p d`: the exponent vectors + `α : Fin d → ℕ` with `α t < p` for each `t` and `3 * ∑ t, α t ≤ (p - 1) * d`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.card_lowDegreeExponents_le`: for `0 < x ≤ 1`, there are + at most `(x ^ (-(p - 1) / 3) * ∑ j ∈ range p, x ^ j) ^ d` such exponent vectors. +-/ + +@[expose] public section + +open Finset + +namespace ArithmeticTriangleRemovalInVectorSpaces + +/-- The exponent vectors `α : Fin d → ℕ` of the monomials in `d` variables in which each variable +has degree less than `p` and whose degree is at most `(p - 1) * d / 3`. -/ +def lowDegreeExponents (p d : ℕ) : Finset (Fin d → ℕ) := + {α ∈ Fintype.piFinset fun _ ↦ range p | 3 * ∑ t, α t ≤ (p - 1) * d} + +/-- A Chernoff bound for the number of monomials of low degree: for `0 < x ≤ 1` there are at most +`(x ^ (-(p - 1) / 3) * ∑ j ∈ range p, x ^ j) ^ d` of them. -/ +lemma card_lowDegreeExponents_le {p : ℕ} (hp : 1 ≤ p) (d : ℕ) {x : ℝ} (hx₀ : 0 < x) + (hx₁ : x ≤ 1) : + #(lowDegreeExponents p d) ≤ (x ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, x ^ j) ^ d := by + calc (#(lowDegreeExponents p d) : ℝ) + = ∑ α ∈ lowDegreeExponents p d, 1 := by simp + _ ≤ ∑ α ∈ lowDegreeExponents p d, x ^ ((∑ t, α t : ℕ) - ((p : ℝ) - 1) * d / 3) := by + gcongr with α hα + refine Real.one_le_rpow_of_pos_of_le_one_of_nonpos hx₀ hx₁ ?_ + obtain ⟨-, h⟩ := mem_filter.1 hα + rw [← Nat.cast_le (α := ℝ)] at h + push_cast [Nat.cast_sub hp] at h ⊢ + linarith + _ ≤ ∑ α ∈ Fintype.piFinset fun _ : Fin d ↦ range p, + x ^ ((∑ t, α t : ℕ) - ((p : ℝ) - 1) * d / 3) := by + apply sum_le_sum_of_subset_of_nonneg (filter_subset _ _) + intros + positivity + _ = x ^ (-(((p : ℝ) - 1) * d / 3)) * ∏ _t : Fin d, ∑ j ∈ range p, x ^ j := by + rw [prod_univ_sum, mul_sum] + congr with α + rw [Real.rpow_sub hx₀, Real.rpow_natCast, ← prod_pow_eq_pow_sum, div_eq_mul_inv, + Real.rpow_neg hx₀.le, mul_comm] + _ = _ := by + rw [prod_const, card_univ, Fintype.card_fin, mul_pow, ← Real.rpow_mul_natCast hx₀.le] + ring_nf + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Product.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Product.lean new file mode 100644 index 0000000000..47051a39d5 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/Product.lean @@ -0,0 +1,189 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Basic +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Triangle.Basic +import Mathlib.Algebra.Order.BigOperators.Group.Finset +import Mathlib.Data.Fintype.Prod +import Mathlib.Tactic.Abel + +/-! +# Products of multicolored sum-free families + +This is the construction of Section 3 of Fox and Lovász. Let `(x i, y i, z i)` be a multicolored +sum-free family of `m` triples in `G`, and let `X`, `Y` and `Z` be the sets of its first, second and +third vertices. For a finite abelian group `W`, the sets `X × W`, `Y × W` and `Z × W` of `G × W` +contain `m * #W ^ 2` triangles, and removing fewer than `m * #W` of their elements leaves a +triangle. With `G = Fin n → ZMod p` and `W = Fin l → ZMod p`, this shows that the exponent `C p` in +the arithmetic triangle removal lemma cannot be lowered. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.IsMulticoloredSumFree.card_triangles_image`: the sets + `X`, `Y` and `Z` contain exactly `m` triangles. +* `ArithmeticTriangleRemovalInVectorSpaces.triangles_nonempty_of_card_sdiff_add_lt`: if `m` + triangles are vertex-disjoint, removing fewer than `m` of their vertices leaves one of them. +* `ArithmeticTriangleRemovalInVectorSpaces.IsMulticoloredSumFree.card_triangles_prod`: the sets + `X × W`, `Y × W` and `Z × W` contain `m * #W ^ 2` triangles. +* `ArithmeticTriangleRemovalInVectorSpaces.IsMulticoloredSumFree.triangles_nonempty`: removing + fewer than `m * #W` elements from them leaves a triangle. +-/ + +public section + +open Finset Function + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {ι G W : Type*} [AddCommGroup G] [AddCommGroup W] {x y z : ι → G} + +/-- The first vertices of a multicolored sum-free family are distinct. -/ +lemma IsMulticoloredSumFree.injective_left (h : IsMulticoloredSumFree x y z) : Injective x := by + intro i j hij + obtain ⟨rfl, -⟩ := (h j i i).1 (hij ▸ (h i i i).2 ⟨rfl, rfl⟩) + rfl + +/-- The second vertices of a multicolored sum-free family are distinct. -/ +lemma IsMulticoloredSumFree.injective_middle (h : IsMulticoloredSumFree x y z) : Injective y := by + intro i j hij + obtain ⟨rfl, -⟩ := (h i j i).1 (hij ▸ (h i i i).2 ⟨rfl, rfl⟩) + rfl + +/-- The third vertices of a multicolored sum-free family are distinct. -/ +lemma IsMulticoloredSumFree.injective_right (h : IsMulticoloredSumFree x y z) : Injective z := by + intro i j hij + obtain ⟨-, rfl⟩ := (h i i j).1 (hij ▸ (h i i i).2 ⟨rfl, rfl⟩) + rfl + +section Base + +variable [DecidableEq G] [Fintype ι] + +/-- The sets `X`, `Y` and `Z` of first, second and third vertices of a multicolored sum-free family +of `m` triples contain exactly `m` triangles. -/ +lemma IsMulticoloredSumFree.card_triangles_image (h : IsMulticoloredSumFree x y z) : + #(triangles (univ.image x) (univ.image y) (univ.image z)) = Fintype.card ι := by + rw [← card_univ] + symm + refine card_bij (fun i _ ↦ (x i, y i, z i)) ?_ ?_ ?_ + · intro i _ + simpa using (h i i i).2 ⟨rfl, rfl⟩ + · intro i _ j _ hij + obtain ⟨hx, -⟩ := Prod.mk.inj hij + exact h.injective_left hx + · rintro ⟨g₁, g₂, g₃⟩ ht + simp only [mem_triangles, mem_image, mem_univ, true_and] at ht + obtain ⟨⟨i, rfl⟩, ⟨j, rfl⟩, ⟨k, rfl⟩, hsum⟩ := ht + obtain ⟨rfl, rfl⟩ := (h i j k).1 hsum + exact ⟨i, mem_univ _, rfl⟩ + +/-- Removing fewer than `m` elements from the vertex sets of `m` vertex-disjoint triangles leaves a +triangle. -/ +lemma triangles_nonempty_of_card_sdiff_add_lt (hx : Injective x) (hy : Injective y) + (hz : Injective z) (hsum : ∀ i, x i + y i + z i = 0) {X Y Z : Finset G} + (hcard : #(univ.image x \ X) + #(univ.image y \ Y) + #(univ.image z \ Z) < Fintype.card ι) : + (triangles X Y Z).Nonempty := by + classical + have hle (f : ι → G) (hf : Injective f) (S : Finset G) : + #({i | f i ∉ S} : Finset ι) ≤ #(univ.image f \ S) := by + apply card_le_card_of_injOn f _ hf.injOn + intro i hi + simp_all + obtain ⟨i, -, hi⟩ : ∃ i ∈ univ, i ∉ (univ.filter fun i ↦ x i ∉ X) ∪ + (univ.filter fun i ↦ y i ∉ Y) ∪ univ.filter fun i ↦ z i ∉ Z := by + apply exists_mem_notMem_of_card_lt_card + grw [card_union_le, card_union_le, hle x hx X, hle y hy Y, hle z hz Z, card_univ] + exact hcard + simp only [mem_union, mem_filter, mem_univ, true_and, not_or, not_not] at hi + obtain ⟨⟨hxi, hyi⟩, hzi⟩ := hi + exact ⟨_, mem_triangles.2 ⟨hxi, hyi, hzi, hsum i⟩⟩ + +end Base + +variable [DecidableEq G] [DecidableEq W] [Fintype ι] [Fintype W] + +/-- The sets `X × W`, `Y × W` and `Z × W` built from a multicolored sum-free family of `m` triples +contain `m * #W ^ 2` triangles. -/ +lemma IsMulticoloredSumFree.card_triangles_prod (h : IsMulticoloredSumFree x y z) : + #(triangles (univ.image x ×ˢ (univ : Finset W)) (univ.image y ×ˢ univ) (univ.image z ×ˢ univ)) + = Fintype.card ι * Fintype.card W ^ 2 := by + rw [sq, ← Fintype.card_prod, ← Fintype.card_prod, ← card_univ] + symm + refine card_bij (fun (i, a, b) _ ↦ ((x i, a), (y i, b), (z i, -(a + b)))) ?_ ?_ ?_ + · rintro ⟨i, a, b⟩ - + simp only [mem_triangles, mem_product, mem_image, mem_univ, true_and, and_true, Prod.ext_iff, + Prod.fst_add, Prod.snd_add, Prod.fst_zero, Prod.snd_zero] + exact ⟨⟨i, rfl⟩, ⟨i, rfl⟩, ⟨i, rfl⟩, (h i i i).2 ⟨rfl, rfl⟩, by abel⟩ + · rintro ⟨i, a, b⟩ _ ⟨j, a', b'⟩ _ hst + simp only [Prod.mk.injEq] at hst + obtain ⟨⟨hx, rfl⟩, ⟨-, rfl⟩, -⟩ := hst + rw [h.injective_left hx] + · rintro ⟨⟨g₁, a⟩, ⟨g₂, b⟩, ⟨g₃, c⟩⟩ ht + simp only [mem_triangles, mem_product, mem_image, mem_univ, true_and, and_true, Prod.ext_iff, + Prod.fst_add, Prod.snd_add, Prod.fst_zero, Prod.snd_zero] at ht + obtain ⟨⟨i, rfl⟩, ⟨j, rfl⟩, ⟨k, rfl⟩, hsum, habc⟩ := ht + obtain ⟨rfl, rfl⟩ := (h i j k).1 hsum + refine ⟨(i, a, b), mem_univ _, ?_⟩ + simp only [Prod.mk.injEq, true_and] + rw [eq_neg_of_add_eq_zero_right habc] + +/-- If the complements of `A`, `B` and `C` in `W` have fewer than `#W` elements in total, then +there are `a ∈ A`, `b ∈ B` and `c ∈ C` with `a + b + c = 0`. -/ +private lemma exists_add_add_eq_zero_of_card_compl_add_lt {A B C : Finset W} + (h : #Aᶜ + #Bᶜ + #Cᶜ < Fintype.card W) : ∃ a ∈ A, ∃ b ∈ B, ∃ c ∈ C, a + b + c = 0 := by + rw [card_compl, card_compl, card_compl] at h + obtain ⟨c, hc⟩ : C.Nonempty := card_pos.1 (by grind [card_le_univ A, card_le_univ B]) + obtain ⟨a, ha⟩ : (A ∩ B.image fun b ↦ -c - b).Nonempty := by + apply inter_nonempty_of_card_lt_card_add_card (subset_univ A) (subset_univ _) + rw [card_image_of_injective _ sub_right_injective, card_univ] + grind [card_le_univ A, card_le_univ B, card_le_univ C] + obtain ⟨ha, hab⟩ := mem_inter.1 ha + obtain ⟨b, hb, rfl⟩ := mem_image.1 hab + exact ⟨_, ha, b, hb, c, hc, by abel⟩ + +omit [AddCommGroup G] [AddCommGroup W] in +/-- For injective `f`, the fibers of `(univ.image f ×ˢ univ) \ S` over the points `f i` have total +size at most `#((univ.image f ×ˢ univ) \ S)`. -/ +private lemma sum_card_filter_notMem_le {f : ι → G} (hf : Injective f) (S : Finset (G × W)) : + ∑ i, #{a | (f i, a) ∉ S} ≤ #((univ.image f ×ˢ univ) \ S) := by + have hdisj : ((univ : Finset ι) : Set ι).PairwiseDisjoint + fun i ↦ ({a | (f i, a) ∉ S} : Finset W).image (f i, ·) := by + rintro i - j - hij + simp only [Function.onFun, disjoint_left, mem_image] + rintro _ ⟨a, -, rfl⟩ ⟨b, -, hb⟩ + obtain ⟨hji, -⟩ := Prod.mk.inj hb + exact hij (hf hji.symm) + have hsub : (univ.biUnion fun i ↦ ({a | (f i, a) ∉ S} : Finset W).image (f i, ·)) ⊆ + (univ.image f ×ˢ univ) \ S := by + intro t ht + simp only [mem_biUnion, mem_image, mem_filter, mem_univ, true_and] at ht + obtain ⟨i, a, ha, rfl⟩ := ht + simp [ha] + grw [← card_le_card hsub, card_biUnion hdisj] + simp [card_image_of_injective _ (Prod.mk_right_injective _)] + +/-- Removing fewer than `m * #W` elements from the sets `X × W`, `Y × W` and `Z × W` built from a +multicolored sum-free family of `m` triples leaves a triangle. -/ +lemma IsMulticoloredSumFree.triangles_nonempty (h : IsMulticoloredSumFree x y z) + {X Y Z : Finset (G × W)} + (hcard : #((univ.image x ×ˢ univ) \ X) + #((univ.image y ×ˢ univ) \ Y) + + #((univ.image z ×ˢ univ) \ Z) < Fintype.card ι * Fintype.card W) : + (triangles X Y Z).Nonempty := by + obtain ⟨i, -, hi⟩ : ∃ i ∈ univ, + #{a | (x i, a) ∉ X} + #{b | (y i, b) ∉ Y} + #{c | (z i, c) ∉ Z} < Fintype.card W := by + apply exists_lt_of_sum_lt + simp_rw [sum_add_distrib] + grw [sum_card_filter_notMem_le h.injective_left X, + sum_card_filter_notMem_le h.injective_middle Y, sum_card_filter_notMem_le h.injective_right Z] + simpa using hcard + obtain ⟨a, ha, b, hb, c, hc, habc⟩ := exists_add_add_eq_zero_of_card_compl_add_lt + (A := {a | (x i, a) ∈ X}) (B := {b | (y i, b) ∈ Y}) (C := {c | (z i, c) ∈ Z}) + (by simpa [compl_filter] using hi) + simp only [mem_filter, mem_univ, true_and] at ha hb hc + exact ⟨_, mem_triangles.2 ⟨ha, hb, hc, Prod.ext ((h i i i).2 ⟨rfl, rfl⟩) habc⟩⟩ + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/SliceRank.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/SliceRank.lean new file mode 100644 index 0000000000..89d72d2321 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/SliceRank.lean @@ -0,0 +1,181 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Basic +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Monomials +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.SliceRank.Diagonal +import Mathlib.Algebra.MvPolynomial.CommRing +import Mathlib.FieldTheory.Finite.Basic + +/-! +# The slice rank bound for multicolored sum-free families + +The indicator function of `x + y + z = 0` on `(Fin d → ZMod p) ^ 3` is the product over the +coordinates `t` of `1 - (x t + y t + z t) ^ (p - 1)`, a polynomial of degree at most `(p - 1) * d`. +Each of its monomials has degree at most `(p - 1) * d / 3` in one of `x`, `y` and `z`, so the +function has slice rank at most `3 * #(lowDegreeExponents p d)`. On a multicolored sum-free family +it restricts to a diagonal function, and Tao's lemma bounds the size of the family. This is the +argument of Croot, Lev and Pach, Ellenberg and Gijswijt, and Blasiak, Church, Cohn, Grochow, +Naslund, Sawin and Umans, in the slice rank language of Tao. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.exists_ite_add_add_eq_zero_eq_sum`: the indicator + function of `u + v + w = 0` on `ZMod p` is a polynomial of degree at most `p - 1`. +* `ArithmeticTriangleRemovalInVectorSpaces.exists_ite_eq_sum_slices`: the decomposition of the + indicator function of `x + y + z = 0` into `3 * #(lowDegreeExponents p d)` slices. +* `ArithmeticTriangleRemovalInVectorSpaces.IsMulticoloredSumFree.card_le_three_mul_card`: a + multicolored sum-free family in `Fin d → ZMod p` has at most `3 * #(lowDegreeExponents p d)` + members. +-/ + +public section + +open Finset MvPolynomial + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {p : ℕ} [Fact p.Prime] + +/-- The indicator function of `u + v + w = 0` on `ZMod p` is a polynomial of degree at most +`p - 1`. -/ +private lemma exists_ite_add_add_eq_zero_eq_sum : + ∃ S : Finset (Fin 3 →₀ ℕ), ∃ κ : (Fin 3 →₀ ℕ) → ZMod p, (∀ e ∈ S, e 0 + e 1 + e 2 ≤ p - 1) ∧ + ∀ u v w : ZMod p, + (if u + v + w = 0 then 1 else 0) = ∑ e ∈ S, κ e * (u ^ e 0 * v ^ e 1 * w ^ e 2) := by + let P : MvPolynomial (Fin 3) (ZMod p) := 1 - (X 0 + X 1 + X 2) ^ (p - 1) + refine ⟨P.support, fun e ↦ P.coeff e, ?_, ?_⟩ + · intro e he + have hdeg := le_totalDegree he + have hP : P.totalDegree ≤ p - 1 := by + grw [totalDegree_sub, totalDegree_one, totalDegree_pow, totalDegree_add, totalDegree_add, + totalDegree_X, totalDegree_X, totalDegree_X] + simp + rw [Finsupp.sum_fintype _ _ (by simp), Fin.sum_univ_three] at hdeg + grind + · intro u v w + have hP := eval_eq' ![u, v, w] P + simp only [Fin.prod_univ_three, Matrix.cons_val_zero, Matrix.cons_val_one, + Matrix.cons_val_two, Matrix.head_cons, Matrix.tail_cons] at hP + rw [← hP] + simp only [P, map_sub, map_one, map_pow, map_add, eval_X, Matrix.cons_val_zero, + Matrix.cons_val_one, Matrix.cons_val_two, Matrix.head_cons, Matrix.tail_cons] + by_cases h : u + v + w = 0 + · simp [h, zero_pow (Nat.sub_ne_zero_of_lt (Fact.out : p.Prime).one_lt)] + · simp [h, ZMod.pow_card_sub_one_eq_one h] + +/-- If the indicator function of `u + v + w = 0` on `ZMod p` is the polynomial with coefficients +`κ e` and exponent vectors `e ∈ S`, then the indicator function of `x + y + z = 0` on +`Fin d → ZMod p` is the product of these polynomials over the coordinates, expanded as a sum over +`σ : Fin d → Fin 3 →₀ ℕ`. -/ +private lemma ite_eq_sum_prod {S : Finset (Fin 3 →₀ ℕ)} {κ : (Fin 3 →₀ ℕ) → ZMod p} + (hf : ∀ u v w : ZMod p, + (if u + v + w = 0 then 1 else 0) = ∑ e ∈ S, κ e * (u ^ e 0 * v ^ e 1 * w ^ e 2)) + {d : ℕ} (x y z : Fin d → ZMod p) : + (if x + y + z = 0 then 1 else 0) = ∑ σ ∈ Fintype.piFinset fun _ ↦ S, + ∏ t, κ (σ t) * (x t ^ σ t 0 * y t ^ σ t 1 * z t ^ σ t 2) := by + rw [← prod_univ_sum (fun _ ↦ S) fun t e ↦ κ e * (x t ^ e 0 * y t ^ e 1 * z t ^ e 2)] + simp_rw [← hf] + rw [prod_boole] + simp [funext_iff] + +omit [Fact p.Prime] in +/-- If every `σ t` is the exponent vector of a monomial of degree at most `p - 1`, then the +degrees of the monomial `∏ t, x t ^ σ t 0 * y t ^ σ t 1 * z t ^ σ t 2` in `x`, `y` and `z` add up +to at most `(p - 1) * d`. -/ +private lemma sum_add_sum_add_sum_le {S : Finset (Fin 3 →₀ ℕ)} + (hS : ∀ e ∈ S, e 0 + e 1 + e 2 ≤ p - 1) + {d : ℕ} {σ : Fin d → Fin 3 →₀ ℕ} (hσ : σ ∈ Fintype.piFinset fun _ ↦ S) : + ∑ t, σ t 0 + ∑ t, σ t 1 + ∑ t, σ t 2 ≤ (p - 1) * d := by + rw [← sum_add_distrib, ← sum_add_distrib] + trans ∑ _t : Fin d, (p - 1) + · apply sum_le_sum + intro t _ + exact hS _ (Fintype.mem_piFinset.1 hσ t) + · simp [mul_comm] + +/-- If every `σ t` is the exponent vector of a monomial of degree at most `p - 1` and the degree +`∑ t, σ t s` in the `s`-th variable is at most `(p - 1) * d / 3`, then `fun t ↦ σ t s` is in +`lowDegreeExponents p d`. -/ +private lemma mem_lowDegreeExponents_of_three_mul_sum_le {S : Finset (Fin 3 →₀ ℕ)} + (hS : ∀ e ∈ S, e 0 + e 1 + e 2 ≤ p - 1) {d : ℕ} {σ : Fin d → Fin 3 →₀ ℕ} + (hσ : σ ∈ Fintype.piFinset fun _ ↦ S) {s : Fin 3} (hs : 3 * ∑ t, σ t s ≤ (p - 1) * d) : + (fun t ↦ σ t s) ∈ lowDegreeExponents p d := by + refine mem_filter.2 ⟨Fintype.mem_piFinset.2 ?_, hs⟩ + intro t + have := hS _ (Fintype.mem_piFinset.1 hσ t) + fin_cases s <;> grind [(Fact.out : p.Prime).one_lt] + +omit [Fact p.Prime] in +/-- Grouping a sum according to a map into a finite set. -/ +private lemma sum_mul_eq_sum_mul_sum {κ α R : Type*} [CommSemiring R] [DecidableEq α] {s : Finset κ} + {A : Finset α} (a : κ → α) (ha : ∀ σ ∈ s, a σ ∈ A) (u : α → R) (v : κ → R) : + ∑ σ ∈ s, u (a σ) * v σ = ∑ α ∈ A, u α * ∑ σ ∈ s with a σ = α, v σ := by + rw [← sum_fiberwise_of_maps_to ha] + congr with α + rw [mul_sum, sum_filter, sum_filter] + congr with σ + grind + +variable (p) in +/-- The indicator function of `x + y + z = 0` on `(Fin d → ZMod p) ^ 3` is a sum of +`3 * #(lowDegreeExponents p d)` slices: products of a monomial `x ^ α`, `y ^ β` or `z ^ γ` of low +degree and a function of the other two variables. -/ +private lemma exists_ite_eq_sum_slices (d : ℕ) : + ∃ F G H : (Fin d → ℕ) → (Fin d → ZMod p) → (Fin d → ZMod p) → ZMod p, + ∀ x y z : Fin d → ZMod p, (if x + y + z = 0 then 1 else 0) = + ∑ α ∈ lowDegreeExponents p d, (∏ t, x t ^ α t) * F α y z + + ∑ β ∈ lowDegreeExponents p d, (∏ t, y t ^ β t) * G β x z + + ∑ γ ∈ lowDegreeExponents p d, (∏ t, z t ^ γ t) * H γ x y := by + classical + obtain ⟨S, κ, hS, hf⟩ := exists_ite_add_add_eq_zero_eq_sum (p := p) + let P := Fintype.piFinset fun _ : Fin d ↦ S + let a (σ : Fin d → Fin 3 →₀ ℕ) (s : Fin 3) : Fin d → ℕ := fun t ↦ σ t s + let low (σ : Fin d → Fin 3 →₀ ℕ) (s : Fin 3) : Prop := 3 * ∑ t, a σ s t ≤ (p - 1) * d + refine ⟨fun α y z ↦ ∑ σ ∈ (P.filter (low · 0)).filter (a · 0 = α), + ∏ t, κ (σ t) * (y t ^ σ t 1 * z t ^ σ t 2), + fun β x z ↦ ∑ σ ∈ ((P.filter (¬low · 0)).filter (low · 1)).filter (a · 1 = β), + ∏ t, κ (σ t) * (x t ^ σ t 0 * z t ^ σ t 2), + fun γ x y ↦ ∑ σ ∈ ((P.filter (¬low · 0)).filter (¬low · 1)).filter (a · 2 = γ), + ∏ t, κ (σ t) * (x t ^ σ t 0 * y t ^ σ t 1), ?_⟩ + intro x y z + rw [ite_eq_sum_prod hf, ← sum_filter_add_sum_filter_not P (low · 0), + ← sum_filter_add_sum_filter_not (P.filter (¬low · 0)) (low · 1), add_assoc, + ← sum_mul_eq_sum_mul_sum (s := P.filter (low · 0)) (a · 0) ?_, + ← sum_mul_eq_sum_mul_sum (s := (P.filter (¬low · 0)).filter (low · 1)) (a · 1) ?_, + ← sum_mul_eq_sum_mul_sum (s := (P.filter (¬low · 0)).filter (¬low · 1)) (a · 2) ?_] + · simp [a, ← prod_mul_distrib, mul_assoc, mul_comm, mul_left_comm] + · intro σ hσ + simp only [mem_filter, low, a] at hσ + obtain ⟨⟨hσP, hσ₀⟩, hσ₁⟩ := hσ + exact mem_lowDegreeExponents_of_three_mul_sum_le hS hσP + (by grind [sum_add_sum_add_sum_le hS hσP]) + · intro σ hσ + simp only [mem_filter] at hσ + obtain ⟨⟨hσP, -⟩, hσ₁⟩ := hσ + exact mem_lowDegreeExponents_of_three_mul_sum_le hS hσP hσ₁ + · intro σ hσ + obtain ⟨hσP, hσ₀⟩ := mem_filter.1 hσ + exact mem_lowDegreeExponents_of_three_mul_sum_le hS hσP hσ₀ + +/-- **The slice rank bound** for multicolored sum-free families: a multicolored sum-free family in +`Fin d → ZMod p` has at most `3 * #(lowDegreeExponents p d)` members. -/ +lemma IsMulticoloredSumFree.card_le_three_mul_card {ι : Type*} [Fintype ι] {d : ℕ} + {x y z : ι → Fin d → ZMod p} (h : IsMulticoloredSumFree x y z) : + Fintype.card ι ≤ 3 * #(lowDegreeExponents p d) := by + classical + obtain ⟨F, G, H, hT⟩ := exists_ite_eq_sum_slices p d + grw [card_le_card_add_card_add_card (A := lowDegreeExponents p d) (B := lowDegreeExponents p d) + (C := lowDegreeExponents p d) (fun α i ↦ ∏ t, x i t ^ α t) (fun α j k ↦ F α (y j) (z k)) + (fun β j ↦ ∏ t, y j t ^ β t) (fun β i k ↦ G β (x i) (z k)) (fun γ k ↦ ∏ t, z k t ^ γ t) + (fun γ i j ↦ H γ (x i) (y j)) ?_] + · grind + · intro i j k + rw [← hT] + simp [h i j k] + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/SmallPrimes.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/SmallPrimes.lean new file mode 100644 index 0000000000..37e1ff0c2d --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/SmallPrimes.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Exponent +import Mathlib.Analysis.MeanInequalities + +/-! +# The exponents `c 2` and `c 3` + +The infimum defining `c p` is attained where the weighted arithmetic-geometric mean inequality is +tight. For `p = 2` this is at `x = 1 / 2`, which gives `c 2 = 5 / 3 - logb 2 3`. For `p = 3` it is +at the root `a = (√33 - 1) / 8` of `4 * a ^ 2 + a - 2`, which gives +`c 3 = 1 - log b / log 3` with `b = a ^ (-2 / 3) + a ^ (1 / 3) + a ^ (4 / 3)`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.c_two`: `c 2 = 5 / 3 - logb 2 3`. +* `ArithmeticTriangleRemovalInVectorSpaces.c_three`: the value of `c 3`. +-/ + +public section + +open Finset + +namespace ArithmeticTriangleRemovalInVectorSpaces + +/-- If the function defining `c p` attains its infimum over `Set.Ioo 0 1` at `a`, then `c p` is +`1 - logb p` of its value at `a`. -/ +private lemma c_eq_one_sub_logb {p : ℕ} (hp : 2 ≤ p) {a : ℝ} (ha₀ : 0 < a) (ha₁ : a < 1) + (h : ∀ x : ℝ, 0 < x → x < 1 → a ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, a ^ j ≤ + x ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, x ^ j) : + c p = 1 - Real.logb p (a ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, a ^ j) := by + rw [← le_antisymm (rpow_one_sub_c_le hp ha₀ ha₁) (le_rpow_one_sub_c hp h), + Real.logb_rpow (by positivity) (by exact_mod_cast (by grind : p ≠ 1))] + ring + +/-- The weighted arithmetic-geometric mean inequality with weights `2 / 3` and `1 / 3`: +`(1 / 2) ^ (-1 / 3) * (3 / 2) ≤ x ^ (-1 / 3) * (1 + x)`. -/ +private lemma rpow_mul_one_add_le {x : ℝ} (hx : 0 < x) : + (1 / 2 : ℝ) ^ (-(1 / 3) : ℝ) * (3 / 2) ≤ x ^ (-(1 / 3) : ℝ) * (1 + x) := by + have h := Real.geom_mean_le_arith_mean2_weighted (w₁ := 2 / 3) (w₂ := 1 / 3) + (p₁ := 3 / 2) (p₂ := 3 / 2 * (x / (1 / 2))) (by norm_num) (by norm_num) (by norm_num) + (by positivity) (by norm_num) + rw [Real.mul_rpow (by norm_num) (by positivity), ← mul_assoc, ← Real.rpow_add (by norm_num), + (by norm_num : (2 / 3 : ℝ) + 1 / 3 = 1), Real.rpow_one, + (by field_simp : 2 / 3 * (3 / 2 : ℝ) + 1 / 3 * (3 / 2 * (x / (1 / 2))) = 1 + x), + Real.div_rpow hx.le (by norm_num), mul_div_assoc', div_le_iff₀ (by positivity)] at h + rw [Real.rpow_neg (by norm_num), Real.rpow_neg hx.le, inv_mul_eq_div, inv_mul_eq_div, + div_le_div_iff₀ (by positivity) (by positivity)] + linarith + +/-- The weighted arithmetic-geometric mean inequality for `1`, `x / a` and `(x / a) ^ 2` with +weights proportional to `1`, `a` and `a ^ 2`, where `4 * a ^ 2 + a - 2 = 0`: +`(x / a) ^ (2 / 3) ≤ (1 + x + x ^ 2) / (1 + a + a ^ 2)`. -/ +private lemma div_rpow_two_div_three_le {a x : ℝ} (ha : 0 < a) (hx : 0 < x) + (hw : 4 * a ^ 2 + a - 2 = 0) : + (x / a) ^ (2 / 3 : ℝ) ≤ (1 + x + x ^ 2) / (1 + a + a ^ 2) := by + have h := Real.geom_mean_le_arith_mean3_weighted (w₁ := 1 / (1 + a + a ^ 2)) + (w₂ := a / (1 + a + a ^ 2)) (w₃ := a ^ 2 / (1 + a + a ^ 2)) (p₁ := 1) (p₂ := x / a) + (p₃ := (x / a) ^ 2) (by positivity) (by positivity) (by positivity) zero_le_one + (by positivity) (by positivity) (by field_simp) + rw [Real.one_rpow, one_mul, ← Real.rpow_natCast_mul (by positivity), + ← Real.rpow_add (by positivity)] at h + convert h using 2 + · field_simp + push_cast + linarith + · field_simp + +/-- The weighted arithmetic-geometric mean inequality with weights proportional to `1`, `a` and +`a ^ 2`, where `4 * a ^ 2 + a - 2 = 0`: +`a ^ (-2 / 3) * (1 + a + a ^ 2) ≤ x ^ (-2 / 3) * (1 + x + x ^ 2)`. -/ +private lemma rpow_mul_one_add_add_sq_le {a x : ℝ} (ha : 0 < a) (hx : 0 < x) + (hw : 4 * a ^ 2 + a - 2 = 0) : + a ^ (-(2 / 3) : ℝ) * (1 + a + a ^ 2) ≤ x ^ (-(2 / 3) : ℝ) * (1 + x + x ^ 2) := by + have h := div_rpow_two_div_three_le ha hx hw + rw [Real.div_rpow hx.le ha.le, div_le_div_iff₀ (by positivity) (by positivity)] at h + rw [Real.rpow_neg ha.le, Real.rpow_neg hx.le, inv_mul_eq_div, inv_mul_eq_div, + div_le_div_iff₀ (by positivity) (by positivity)] + linarith + +/-- The exponent `c 2` is `5 / 3 - logb 2 3`. -/ +theorem c_two : c 2 = 5 / 3 - Real.logb 2 3 := by + rw [c_eq_one_sub_logb le_rfl (a := 1 / 2) (by norm_num) (by norm_num) ?_] + · norm_num [sum_range_succ] + rw [Real.logb_mul (by positivity) (by norm_num), Real.logb_rpow_eq_mul_logb_of_pos + (by norm_num), Real.logb_div (by norm_num) (by norm_num), Real.logb_div (by norm_num) + (by norm_num), Real.logb_one, Real.logb_self_eq_one (by norm_num)] + ring + · intro x hx₀ hx₁ + norm_num [sum_range_succ] + exact rpow_mul_one_add_le hx₀ + +/-- With `a = (√33 - 1) / 8` and `b = a ^ (-2 / 3) + a ^ (1 / 3) + a ^ (4 / 3)`, the exponent +`c 3` is `1 - log b / log 3`. -/ +theorem c_three {a : ℝ} (ha : a = (√33 - 1) / 8) : + c 3 = 1 - Real.log (a ^ (-2 / 3 : ℝ) + a ^ (1 / 3 : ℝ) + a ^ (4 / 3 : ℝ)) / Real.log 3 := by + have h33 : √33 ^ 2 = 33 := Real.sq_sqrt (by norm_num) + obtain ⟨ha₀, ha₁⟩ : 0 < a ∧ a < 1 := by + rw [ha] + constructor <;> nlinarith [Real.sqrt_nonneg 33] + rw [c_eq_one_sub_logb (by norm_num) ha₀ ha₁ ?_] + · norm_num [sum_range_succ] + rw [Real.logb, mul_add, mul_add, mul_one, ← Real.rpow_add_one ha₀.ne', + ← Real.rpow_add_natCast ha₀.ne'] + norm_num + · intro x hx₀ hx₁ + norm_num [sum_range_succ] + apply rpow_mul_one_add_add_sq_le ha₀ hx₀ + rw [ha] + linear_combination h33 / 16 + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/TensorPower.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/TensorPower.lean new file mode 100644 index 0000000000..734f303deb --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/MulticoloredSumFree/TensorPower.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Basic +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Exponent +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.SliceRank +import Mathlib.Algebra.Field.ZMod +import Mathlib.Data.Sym.Sym2.Init +import Mathlib.FieldTheory.Finiteness +import Mathlib.LinearAlgebra.FreeModule.StrongRankCondition +import Mathlib.RingTheory.SimpleModule.Basic +import Mathlib.Tactic.NormNum.GCD +import Mathlib.Tactic.Positivity.Finset + +/-! +# The Kleinberg–Sawin–Speyer bound + +A multicolored sum-free family in a finite vector space `G` over `ZMod p` has at most +`#G ^ (1 - c p)` members. The slice rank bound and the Chernoff bound give this up to a factor `3`, +and the bound for the coordinatewise powers of the family removes the factor, as in Kleinberg, +Sawin and Speyer. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.IsMulticoloredSumFree.card_le_three_mul_pow`: the bound + `3 * (t ^ (-(p - 1) / 3) * ∑ j ∈ range p, t ^ j) ^ finrank (ZMod p) G` for `0 < t ≤ 1`. +* `ArithmeticTriangleRemovalInVectorSpaces.IsMulticoloredSumFree.card_le_pow`: the same bound + without the factor `3`, for `0 < t < 1`. +* `ArithmeticTriangleRemovalInVectorSpaces.IsMulticoloredSumFree.card_le_card_rpow`: the bound + `#G ^ (1 - c p)`. +-/ + +public section + +open Finset Module + +namespace ArithmeticTriangleRemovalInVectorSpaces + +/-- If `a ^ k ≤ M * b ^ k` for every `k` and `b > 0`, then `a ≤ b`. -/ +lemma le_of_forall_pow_le_mul_pow {a b M : ℝ} (hb : 0 < b) (h : ∀ k : ℕ, a ^ k ≤ M * b ^ k) : + a ≤ b := by + by_contra! hba + obtain ⟨k, hk⟩ := pow_unbounded_of_one_lt M ((one_lt_div hb).2 hba) + rw [div_pow, lt_div_iff₀ (by positivity)] at hk + linarith [h k] + +variable {p : ℕ} [Fact p.Prime] {G ι : Type*} [AddCommGroup G] [Module (ZMod p) G] [Fintype ι] + {x y z : ι → G} + +/-- A multicolored sum-free family in a finite vector space `G` over `ZMod p` has at most +`3 * (t ^ (-(p - 1) / 3) * ∑ j ∈ range p, t ^ j) ^ finrank (ZMod p) G` members, for `0 < t ≤ 1`. -/ +private lemma IsMulticoloredSumFree.card_le_three_mul_pow [Finite G] + (h : IsMulticoloredSumFree x y z) {t : ℝ} (ht₀ : 0 < t) (ht₁ : t ≤ 1) : + Fintype.card ι ≤ + 3 * (t ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, t ^ j) ^ finrank (ZMod p) G := by + let e := (Module.finBasis (ZMod p) G).equivFun + grw [← card_lowDegreeExponents_le (Fact.out : p.Prime).one_lt.le _ ht₀ ht₁] + exact_mod_cast (h.map e.toLinearMap.toAddMonoidHom e.injective).card_le_three_mul_card + +/-- The tensor power trick removes the factor `3` of `card_le_three_mul_pow`: a multicolored +sum-free family in a finite vector space `G` over `ZMod p` has at most +`(t ^ (-(p - 1) / 3) * ∑ j ∈ range p, t ^ j) ^ finrank (ZMod p) G` members, for `0 < t < 1`. -/ +private lemma IsMulticoloredSumFree.card_le_pow [Finite G] (h : IsMulticoloredSumFree x y z) {t : ℝ} + (ht₀ : 0 < t) (ht₁ : t < 1) : + Fintype.card ι ≤ (t ^ (-((p : ℝ) - 1) / 3) * ∑ j ∈ range p, t ^ j) ^ finrank (ZMod p) G := by + refine le_of_forall_pow_le_mul_pow (M := 3) (pow_pos ?_ _) ?_ + · linarith [three_div_two_le_rpow_mul_sum (Fact.out : p.Prime).two_le ht₀ ht₁] + · intro k + have := (h.pi (Fin k)).card_le_three_mul_pow (p := p) ht₀ ht₁.le + rw [finrank_pi_fintype, sum_const, card_univ, Fintype.card_fin, smul_eq_mul, pow_mul', + Fintype.card_fun, Fintype.card_fin] at this + exact_mod_cast this + +/-- **The Kleinberg–Sawin–Speyer bound.** A multicolored sum-free family in a finite vector space +`G` over `ZMod p` has at most `#G ^ (1 - c p)` members. -/ +lemma IsMulticoloredSumFree.card_le_card_rpow [Fintype G] (h : IsMulticoloredSumFree x y z) : + (Fintype.card ι : ℝ) ≤ Fintype.card G ^ (1 - c p) := by + have hp := (Fact.out : p.Prime).two_le + rw [card_eq_pow_finrank (K := ZMod p) (V := G), ZMod.card, Nat.cast_pow, ← Real.rpow_natCast, + ← Real.rpow_mul (by positivity), mul_comm, Real.rpow_mul (by positivity), Real.rpow_natCast] + rcases Nat.eq_zero_or_pos (finrank (ZMod p) G) with hd | hd + · simpa [hd] using h.card_le_pow (p := p) (t := 1 / 2) (by norm_num) (by norm_num) + rw [← Real.rpow_inv_natCast_pow (Nat.cast_nonneg (Fintype.card ι)) hd.ne'] + gcongr + apply le_rpow_one_sub_c hp + intro t ht₀ ht₁ + rw [Real.rpow_inv_le_iff_of_pos (by positivity) + (by linarith [three_div_two_le_rpow_mul_sum hp ht₀ ht₁]) (by positivity), Real.rpow_natCast] + exact h.card_le_pow ht₀ ht₁ + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/SliceRank/Diagonal.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/SliceRank/Diagonal.lean new file mode 100644 index 0000000000..4685dfbe3c --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/SliceRank/Diagonal.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import Mathlib.Algebra.BigOperators.Group.Finset.Defs +public import Mathlib.Algebra.Field.Defs +public import Mathlib.Data.Fintype.Card +import Mathlib.LinearAlgebra.Matrix.Rank + +/-! +# The slice rank of a diagonal tensor + +A function `T : ι → ι → ι → F` has slice rank at most `r` if it is a sum of `r` products, each of +a function of one of the three variables and a function of the other two. This file proves Tao's +lemma: the diagonal function `fun i j k ↦ if i = j ∧ j = k then 1 else 0` has slice rank +`Fintype.card ι`. We only state the inequality that the polynomial method uses. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.exists_mem_finrank_le_card`: a subspace `W` of `ι → F` + contains a vector with at least `finrank F W` nonzero coordinates. +* `ArithmeticTriangleRemovalInVectorSpaces.card_le_card_add_card_add_card`: if the diagonal + function is a sum of `#A + #B + #C` such products, then `Fintype.card ι ≤ #A + #B + #C`. +-/ + +public section + +open Finset Matrix Module + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {ι F : Type*} [Fintype ι] [Field F] + +omit [Fintype ι] in +/-- A subspace `W` of `ι → F` with `#s < finrank F W` contains a nonzero vector that vanishes on +`s`. -/ +private lemma exists_mem_ne_zero_forall_eq_zero_of_card_lt_finrank [Finite ι] + (W : Submodule F (ι → F)) + {s : Finset ι} (hs : #s < finrank F W) : ∃ v ∈ W, v ≠ 0 ∧ ∀ i ∈ s, v i = 0 := by + obtain ⟨⟨v, hvW⟩, hv, hv0⟩ := Submodule.exists_mem_ne_zero_of_ne_bot + (LinearMap.ker_ne_bot_of_finrank_lt + (f := (LinearMap.funLeft F F ((↑) : s → ι)).comp W.subtype) (by simpa)) + refine ⟨v, hvW, by simpa using hv0, ?_⟩ + intro i hi + simpa using congr_fun (LinearMap.mem_ker.1 hv) ⟨i, hi⟩ + +/-- A subspace `W` of `ι → F` contains a vector with at least `finrank F W` nonzero coordinates. -/ +private lemma exists_mem_finrank_le_card [DecidableEq F] (W : Submodule F (ι → F)) : + ∃ w ∈ W, finrank F W ≤ #{i | w i ≠ 0} := by + classical + obtain ⟨s, hs, hmax⟩ := exists_max_image + ({s | ∃ w ∈ W, ({i | w i ≠ 0} : Finset ι) = s} : Finset (Finset ι)) card + ⟨∅, by simpa using ⟨0, W.zero_mem, by simp⟩⟩ + obtain ⟨-, w, hw, rfl⟩ := mem_filter.1 hs + refine ⟨w, hw, not_lt.1 ?_⟩ + intro hlt + obtain ⟨v, hvW, hv0, hvs⟩ := exists_mem_ne_zero_forall_eq_zero_of_card_lt_finrank W hlt + obtain ⟨i₀, hi₀⟩ : ∃ i, v i ≠ 0 := Function.ne_iff.1 hv0 + simp only [mem_filter, mem_univ, true_and] at hvs + refine (hmax _ (mem_filter.2 ⟨mem_univ _, w + v, W.add_mem hw hvW, rfl⟩)).not_gt + (card_lt_card ⟨?_, ?_⟩) + · intro i hi + simp_all + · rw [not_subset] + exact ⟨i₀, by simp [(by grind : w i₀ = 0), hi₀], by grind⟩ + +/-- For functions `f a : ι → F` indexed by `a ∈ A`, some `w : ι → F` orthogonal to all of them has +at least `Fintype.card ι - #A` nonzero coordinates. -/ +private lemma exists_forall_sum_mul_eq_zero_card_le [DecidableEq F] {α : Type*} (A : Finset α) + (f : α → ι → F) : + ∃ w : ι → F, (∀ a ∈ A, ∑ i, w i * f a i = 0) ∧ Fintype.card ι ≤ #A + #{i | w i ≠ 0} := by + let L : Matrix A ι F := of fun a i ↦ f a i + obtain ⟨w, hw, hcard⟩ := exists_mem_finrank_le_card (LinearMap.ker L.mulVecLin) + refine ⟨w, ?_, ?_⟩ + · intro a ha + simpa [L, mulVec, dotProduct, mul_comm] using congr_fun (LinearMap.mem_ker.1 hw) ⟨a, ha⟩ + · have := L.rank_le_card_height + rw [Matrix.rank, Fintype.card_coe] at this + grind [L.mulVecLin.finrank_range_add_finrank_ker, finrank_fintype_fun_eq_card] + +/-- If the diagonal function on `ι × ι × ι` is a sum of products of functions as in +`card_le_card_add_card_add_card`, and `w` is orthogonal to the functions `f a`, then `w` has at +most `#B + #C` nonzero coordinates: the diagonal matrix with diagonal `w` factors through +`B ⊕ C`. -/ +private lemma card_filter_ne_zero_le_card_add_card [DecidableEq ι] [DecidableEq F] {α β γ : Type*} + {A : Finset α} {B : Finset β} {C : Finset γ} (f : α → ι → F) (g : α → ι → ι → F) + (f' : β → ι → F) (g' : β → ι → ι → F) (f'' : γ → ι → F) (g'' : γ → ι → ι → F) + (h : ∀ i j k, (if i = j ∧ j = k then 1 else 0 : F) = + ∑ a ∈ A, f a i * g a j k + ∑ b ∈ B, f' b j * g' b i k + ∑ c ∈ C, f'' c k * g'' c i j) + {w : ι → F} (hw : ∀ a ∈ A, ∑ i, w i * f a i = 0) : + #{i | w i ≠ 0} ≤ #B + #C := by + let P : Matrix ι (B ⊕ C) F := + fun j x ↦ x.elim (fun b : B ↦ f' b j) fun c : C ↦ ∑ i, w i * g'' c i j + let Q : Matrix (B ⊕ C) ι F := + fun x k ↦ x.elim (fun b : B ↦ ∑ i, w i * g' b i k) fun c : C ↦ f'' c k + have hPQ : diagonal w = P * Q := by + ext j k + trans ∑ i, w i * (if i = j ∧ j = k then 1 else 0 : F) + · by_cases hjk : j = k <;> simp [diagonal, hjk] + rw [Matrix.mul_apply, Fintype.sum_sum_type] + simp only [P, Q, Sum.elim_inl, Sum.elim_inr] + rw [sum_coe_sort B fun b ↦ f' b j * ∑ i, w i * g' b i k, + sum_coe_sort C fun c ↦ (∑ i, w i * g'' c i j) * f'' c k] + simp_rw [h, mul_add, sum_add_distrib, mul_sum, sum_mul] + rw [sum_comm, sum_eq_zero, zero_add, sum_comm, sum_comm (s := univ)] + · congr 1 <;> congr with x <;> congr with i <;> ring + · intro a ha + simp_rw [← mul_assoc, ← sum_mul, hw a ha, zero_mul] + rw [← Fintype.card_subtype, ← rank_diagonal, hPQ] + grw [rank_mul_le_left, rank_le_card_width] + simp + +/-- **Tao's lemma** on the slice rank of a diagonal tensor. If the function +`fun i j k ↦ if i = j ∧ j = k then 1 else 0` on `ι × ι × ι` is a sum of `#A + #B + #C` products, +each of a function of one variable and a function of the other two, then `ι` has at most +`#A + #B + #C` elements. -/ +lemma card_le_card_add_card_add_card [DecidableEq ι] {α β γ : Type*} {A : Finset α} {B : Finset β} + {C : Finset γ} (f : α → ι → F) (g : α → ι → ι → F) (f' : β → ι → F) (g' : β → ι → ι → F) + (f'' : γ → ι → F) (g'' : γ → ι → ι → F) + (h : ∀ i j k, (if i = j ∧ j = k then 1 else 0 : F) = + ∑ a ∈ A, f a i * g a j k + ∑ b ∈ B, f' b j * g' b i k + ∑ c ∈ C, f'' c k * g'' c i j) : + Fintype.card ι ≤ #A + #B + #C := by + classical + obtain ⟨w, hw, hcard⟩ := exists_forall_sum_mul_eq_zero_card_le A f + grw [hcard, card_filter_ne_zero_le_card_add_card f g f' g' f'' g'' h hw, add_assoc] + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Tightness/Exponent.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Tightness/Exponent.lean new file mode 100644 index 0000000000..b835a242a8 --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Tightness/Exponent.lean @@ -0,0 +1,147 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import Mathlib.Analysis.SpecialFunctions.Pow.Real + +/-! +# The exponent of the upper bound on `δ` + +Section 3 of Fox and Lovász turns a multicolored sum-free family of `m` triples in +`Fin n → ZMod p` into the bound `δ * N ^ 2 ≤ m` for any `δ` that works in the removal lemma with +`ε < m / N`, where `N = p ^ n`. This file contains the real arithmetic that turns this bound into +`δ ≤ ε ^ (C p - η)`: the choice of `n` from `ε`, and the comparison of the exponents. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.exists_lt_pow_le_inv_lt`: for `t > 1` and small `ε` + there is a large `n` with `t ^ n ≤ ε⁻¹ < t ^ (n + 1)`. +* `ArithmeticTriangleRemovalInVectorSpaces.mul_pow_lt_of_rpow_mul_le`: the lower bound + `(P ^ γ) ^ n ≤ ε⁻¹` makes `ε * P ^ n` smaller than a family of size `P ^ (a * n)`. +* `ArithmeticTriangleRemovalInVectorSpaces.inv_pow_le_mul_rpow`: the upper bound + `ε⁻¹ < (P ^ κ⁻¹) ^ (n + 1)` gives `(P ^ n)⁻¹ ≤ P * ε ^ κ`. +* `ArithmeticTriangleRemovalInVectorSpaces.le_mul_rpow_one_add_of_mul_sq_le`: the bound + `δ ≤ (P + P ^ 2) * ε ^ (1 + κ)` from `δ * N ^ 2 ≤ ε * N + 1` and `N⁻¹ ≤ P * ε ^ κ`. +* `ArithmeticTriangleRemovalInVectorSpaces.mul_rpow_le_rpow_sub`: a constant factor `A` is absorbed + by lowering the exponent, for small `ε`. +* `ArithmeticTriangleRemovalInVectorSpaces.mul_min_div_two_lt_inv_max_sub` and + `ArithmeticTriangleRemovalInVectorSpaces.div_le_sq_div_mul_min_div_two`: the exponent + `η' = c * min (1 - c) (c * η / 2) / 2` of the bound `ε₀` is small enough. +-/ + +public section + +namespace ArithmeticTriangleRemovalInVectorSpaces + +/-- For `t > 1` and `0 < ε < t ^ (-(n₀ + 1))` there is `n > n₀` with `t ^ n ≤ ε⁻¹ < t ^ (n + 1)`. -/ +lemma exists_lt_pow_le_inv_lt {t ε : ℝ} (ht : 1 < t) {n₀ : ℕ} (hε0 : 0 < ε) + (hε : ε < (t ^ (n₀ + 1))⁻¹) : ∃ n, n₀ < n ∧ t ^ n ≤ ε⁻¹ ∧ ε⁻¹ < t ^ (n + 1) := by + have hlt : t ^ (n₀ + 1) < ε⁻¹ := (lt_inv_comm₀ hε0 (by positivity)).1 hε + obtain ⟨n, hn, hn'⟩ := exists_nat_pow_near ((one_le_pow₀ ht.le).trans hlt.le) ht + exact ⟨n, Nat.succ_lt_succ_iff.1 ((pow_lt_pow_iff_right₀ ht).1 (hlt.trans hn')), hn, hn'⟩ + +/-- If `(P ^ γ) ^ n ≤ ε⁻¹` and `P ^ (a * n) ≤ m` with `1 - γ < a`, `P > 1` and `n > 0`, then +`ε * P ^ n < m`. -/ +lemma mul_pow_lt_of_rpow_mul_le {P ε γ a m : ℝ} {n : ℕ} (hP : 1 < P) (hε : 0 < ε) (hn : 0 < n) + (ha : 1 - γ < a) (h : (P ^ γ) ^ n ≤ ε⁻¹) (hm : P ^ (a * n) ≤ m) : ε * P ^ n < m := by + calc ε * P ^ n ≤ ((P ^ γ) ^ n)⁻¹ * P ^ n := by + grw [(le_inv_comm₀ hε (by positivity)).2 h] + _ = P ^ ((1 - γ) * n) := by + rw [← Real.rpow_mul_natCast (by positivity), ← Real.rpow_neg (by positivity), + ← Real.rpow_natCast, ← Real.rpow_add (by positivity)] + ring_nf + _ < P ^ (a * n) := + Real.rpow_lt_rpow_of_exponent_lt hP (mul_lt_mul_of_pos_right ha (by exact_mod_cast hn)) + _ ≤ m := hm + +/-- If `ε⁻¹ < (P ^ κ⁻¹) ^ (n + 1)` with `P, ε, κ > 0`, then `(P ^ n)⁻¹ ≤ P * ε ^ κ`. -/ +lemma inv_pow_le_mul_rpow {P ε κ : ℝ} {n : ℕ} (hP : 0 < P) (hε : 0 < ε) (hκ : 0 < κ) + (h : ε⁻¹ < (P ^ κ⁻¹) ^ (n + 1)) : (P ^ n)⁻¹ ≤ P * ε ^ κ := by + have := Real.rpow_lt_rpow (by positivity) h hκ + rw [← Real.rpow_mul_natCast hP.le, ← Real.rpow_mul hP.le, mul_right_comm, + inv_mul_cancel₀ hκ.ne', one_mul, Real.rpow_natCast, Real.inv_rpow hε.le, + inv_lt_iff_one_lt_mul₀ (by positivity), pow_succ'] at this + rw [inv_le_iff_one_le_mul₀ (by positivity)] + linarith + +/-- If `δ * N ^ 2 ≤ ε * N + 1` and `N⁻¹ ≤ P * ε ^ κ` with `κ ≥ 1` and `0 < ε ≤ 1`, then +`δ ≤ (P + P ^ 2) * ε ^ (1 + κ)`. -/ +lemma le_mul_rpow_one_add_of_mul_sq_le {P N ε δ κ : ℝ} (hP : 0 < P) (hN : 0 < N) (hε0 : 0 < ε) + (hε₁ : ε ≤ 1) (hκ : 1 ≤ κ) (hNε : N⁻¹ ≤ P * ε ^ κ) (hδ : δ * N ^ 2 ≤ ε * N + 1) : + δ ≤ (P + P ^ 2) * ε ^ (1 + κ) := by + have hεκ : ε ^ κ ≤ ε := by + simpa using Real.rpow_le_rpow_of_exponent_ge hε0 hε₁ hκ + calc δ ≤ (ε * N + 1) / N ^ 2 := (le_div_iff₀ (by positivity)).2 hδ + _ = ε * N⁻¹ + N⁻¹ ^ 2 := by field_simp + _ ≤ ε * (P * ε ^ κ) + (P * ε ^ κ) ^ 2 := by gcongr + _ ≤ (P + P ^ 2) * (ε * ε ^ κ) := by + nlinarith [Real.rpow_pos_of_pos hε0 κ, mul_le_mul_of_nonneg_left hεκ + (by positivity : 0 ≤ P ^ 2 * ε ^ κ)] + _ = (P + P ^ 2) * ε ^ (1 + κ) := by rw [Real.rpow_add hε0, Real.rpow_one] + +/-- For `A > 0` and `0 < ε ≤ A⁻¹ ^ (2 / η)` with `ε ≤ 1`, lowering the exponent from `1 + κ` to +`C - η`, where `C - η / 2 ≤ 1 + κ`, absorbs the factor `A`: `A * ε ^ (1 + κ) ≤ ε ^ (C - η)`. -/ +lemma mul_rpow_le_rpow_sub {A ε κ C η : ℝ} (hA : 0 < A) (hε0 : 0 < ε) (hε₁ : ε ≤ 1) (hη : 0 < η) + (hκ : C - η / 2 ≤ 1 + κ) (hε : ε ≤ A⁻¹ ^ (2 / η)) : A * ε ^ (1 + κ) ≤ ε ^ (C - η) := by + have hεη : ε ^ (η / 2) ≤ A⁻¹ := by + grw [hε, ← Real.rpow_mul (by positivity), div_mul_div_cancel₀ (by positivity), + div_self two_ne_zero, Real.rpow_one] + calc A * ε ^ (1 + κ) ≤ A * ε ^ (C - η / 2) := by + grw [Real.rpow_le_rpow_of_exponent_ge hε0 hε₁ hκ] + _ = A * ε ^ (η / 2) * ε ^ (C - η) := by + rw [mul_assoc, ← Real.rpow_add hε0] + ring_nf + _ ≤ ε ^ (C - η) := by + grw [hεη, mul_inv_cancel₀ hA.ne', one_mul] + +/-- For `P ≥ 2`, `η > 0` and `6 / η ≤ n`, `(P ^ n)⁻¹ ≤ (P + P ^ 2)⁻¹ ^ (2 / η)`. -/ +lemma inv_pow_le_inv_add_sq_rpow {P η : ℝ} (hP : 2 ≤ P) (hη : 0 < η) {n : ℕ} (hn : 6 / η ≤ n) : + (P ^ n)⁻¹ ≤ (P + P ^ 2)⁻¹ ^ (2 / η) := by + rw [Real.inv_rpow (by positivity)] + gcongr + grw [(by nlinarith : P + P ^ 2 ≤ P ^ 3), ← Real.rpow_natCast_mul (by positivity), + ← Real.rpow_natCast] + exact Real.rpow_le_rpow_of_exponent_le (by linarith) + (by push_cast; linarith [(by ring : 3 * (2 / η) = 6 / η)]) + +/-- For `κ > 0`, `c * (1 - c * κ) ≤ κ⁻¹ - c`. -/ +private lemma mul_one_sub_mul_le_inv_sub {c κ : ℝ} (hκ : 0 < κ) : c * (1 - c * κ) ≤ κ⁻¹ - c := by + rw [le_sub_iff_add_le, ← mul_one κ⁻¹, le_inv_mul_iff₀ hκ] + nlinarith [sq_nonneg (1 - c * κ)] + +lemma mul_min_div_two_pos {c η : ℝ} (hc₀ : 0 < c) (hc₁ : c < 1) (hη : 0 < η) : + 0 < c * min (1 - c) (c * η / 2) / 2 := by + have := lt_min (sub_pos.2 hc₁) (by positivity : 0 < c * η / 2) + positivity + +/-- For `0 < c < 1` and `η > 0`, the exponent `η' = c * min (1 - c) (c * η / 2) / 2` satisfies +`η' < 1 / κ - c` for `κ = max 1 (1 / c - η / 2)`. -/ +lemma mul_min_div_two_lt_inv_max_sub {c η : ℝ} (hc₀ : 0 < c) (hc₁ : c < 1) (hη : 0 < η) : + c * min (1 - c) (c * η / 2) / 2 < (max 1 (c⁻¹ - η / 2))⁻¹ - c := by + have hmin : min (1 - c) (c * η / 2) ≤ 1 - c * max 1 (c⁻¹ - η / 2) := by + rcases le_total 1 (c⁻¹ - η / 2) with h | h + · rw [max_eq_right h, mul_sub, mul_inv_cancel₀ hc₀.ne'] + linarith [min_le_right (1 - c) (c * η / 2)] + · rw [max_eq_left h, mul_one] + exact min_le_left _ _ + grw [← mul_one_sub_mul_le_inv_sub (lt_max_of_lt_left one_pos)] + linarith [mul_le_mul_of_nonneg_left hmin hc₀.le, mul_min_div_two_pos hc₀ hc₁ hη] + +/-- For `0 < c < 1`, `η > 0` and `X ≥ 1`, the exponent `η' = c * min (1 - c) (c * η / 2) / 2` +satisfies `6 / η ≤ (X / η') ^ 2`. -/ +lemma div_le_sq_div_mul_min_div_two {c η X : ℝ} (hc₀ : 0 < c) (hc₁ : c < 1) (hη : 0 < η) + (hX : 1 ≤ X) : 6 / η ≤ (X / (c * min (1 - c) (c * η / 2) / 2)) ^ 2 := by + have h := mul_min_div_two_pos hc₀ hc₁ hη + have hη' : c * min (1 - c) (c * η / 2) / 2 ≤ η / 4 := by + nlinarith [mul_le_mul_of_nonneg_left (min_le_right (1 - c) (c * η / 2)) hc₀.le, + mul_le_mul_of_nonneg_right (by nlinarith : c * c ≤ 1) hη.le] + have h₈ : c * min (1 - c) (c * η / 2) / 2 ≤ 1 / 8 := by + nlinarith [mul_le_mul_of_nonneg_left (min_le_left (1 - c) (c * η / 2)) hc₀.le, + sq_nonneg (c - 1 / 2)] + rw [div_pow, div_le_div_iff₀ hη (pow_pos h 2)] + nlinarith [mul_le_mul hη' h₈ h.le (by positivity), one_le_pow₀ (n := 2) hX] + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Triangle/Basic.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Triangle/Basic.lean new file mode 100644 index 0000000000..5bd283e72d --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/Triangle/Basic.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import Mathlib.Algebra.Group.Pi.Basic +public import Mathlib.Data.Finset.Prod +public import Mathlib.Data.Fintype.Pi +import Mathlib.Data.Fintype.BigOperators + +/-! +# Triangles + +A triangle in an abelian group is a triple `(x, y, z)` with `x + y + z = 0`. This file defines the +set of triangles of `X × Y × Z` for finite sets `X`, `Y` and `Z`. + +## Main definitions + +* `ArithmeticTriangleRemovalInVectorSpaces.triangles X Y Z`: the triangles in `X × Y × Z`. + +## Main statements + +* `ArithmeticTriangleRemovalInVectorSpaces.card_triangles_le_card_sq`: there are at most `#G ^ 2` + triangles. +* `ArithmeticTriangleRemovalInVectorSpaces.card_triangles_erase_left`: removing a vertex `v` from + `X` removes the triangles whose first vertex is `v`, and similarly for `Y` and `Z`. +* `ArithmeticTriangleRemovalInVectorSpaces.card_triangles_piFinset`: the triangles of the + coordinatewise powers `X ^ k`, `Y ^ k` and `Z ^ k` number `#(triangles X Y Z) ^ k`. +-/ + +@[expose] public section + +open Finset + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {G : Type*} [AddCommGroup G] [DecidableEq G] + +/-- The triangles of `X × Y × Z`: the triples `(x, y, z)` with `x + y + z = 0`. -/ +def triangles (X Y Z : Finset G) : Finset (G × G × G) := + (X ×ˢ Y ×ˢ Z).filter fun (x, y, z) ↦ x + y + z = 0 + +variable {X Y Z X' Y' Z' : Finset G} {x y z : G} + +@[simp] +lemma mem_triangles : (x, y, z) ∈ triangles X Y Z ↔ x ∈ X ∧ y ∈ Y ∧ z ∈ Z ∧ x + y + z = 0 := by + simp [triangles, and_assoc] + +lemma triangles_eq_empty_iff : + triangles X Y Z = ∅ ↔ ∀ x ∈ X, ∀ y ∈ Y, ∀ z ∈ Z, x + y + z ≠ 0 := by + simp only [eq_empty_iff_forall_notMem, Prod.forall, mem_triangles] + grind + +lemma triangles_mono (hX : X' ⊆ X) (hY : Y' ⊆ Y) (hZ : Z' ⊆ Z) : + triangles X' Y' Z' ⊆ triangles X Y Z := + filter_subset_filter _ (product_subset_product hX (product_subset_product hY hZ)) + +/-- A triangle is determined by its first two vertices, so there are at most `#G ^ 2` triangles. -/ +lemma card_triangles_le_card_sq [Fintype G] (X Y Z : Finset G) : + #(triangles X Y Z) ≤ Fintype.card G ^ 2 := by + rw [sq, ← Fintype.card_prod, ← card_univ] + refine card_le_card_of_injOn (fun (x, y, _) ↦ (x, y)) (fun _ _ ↦ mem_univ _) ?_ + rintro ⟨x, y, z⟩ ht ⟨x', y', z'⟩ ht' h + simp only [mem_coe, mem_triangles, Prod.mk.injEq] at ht ht' h ⊢ + grind + +/-- Removing a vertex `v` from `X` removes the triangles whose first vertex is `v`. -/ +lemma card_triangles_erase_left (X Y Z : Finset G) (v : G) : + #(triangles (X.erase v) Y Z) + #((triangles X Y Z).filter fun (x, _, _) ↦ x = v) = + #(triangles X Y Z) := by + rw [add_comm, ← card_filter_add_card_filter_not (s := triangles X Y Z) fun (x, _, _) ↦ x = v] + congr 2 + ext ⟨x, y, z⟩ + simp only [mem_triangles, mem_filter, mem_erase] + grind + +/-- Removing a vertex `v` from `Y` removes the triangles whose second vertex is `v`. -/ +lemma card_triangles_erase_middle (X Y Z : Finset G) (v : G) : + #(triangles X (Y.erase v) Z) + #((triangles X Y Z).filter fun (_, y, _) ↦ y = v) = + #(triangles X Y Z) := by + rw [add_comm, ← card_filter_add_card_filter_not (s := triangles X Y Z) fun (_, y, _) ↦ y = v] + congr 2 + ext ⟨x, y, z⟩ + simp only [mem_triangles, mem_filter, mem_erase] + grind + +/-- Removing a vertex `v` from `Z` removes the triangles whose third vertex is `v`. -/ +lemma card_triangles_erase_right (X Y Z : Finset G) (v : G) : + #(triangles X Y (Z.erase v)) + #((triangles X Y Z).filter fun (_, _, z) ↦ z = v) = + #(triangles X Y Z) := by + rw [add_comm, ← card_filter_add_card_filter_not (s := triangles X Y Z) fun (_, _, z) ↦ z = v] + congr 2 + ext ⟨x, y, z⟩ + simp only [mem_triangles, mem_filter, mem_erase] + grind + +/-- The triangles of the coordinatewise powers `X ^ k`, `Y ^ k` and `Z ^ k` are the `k`-tuples of +triangles of `X × Y × Z`. -/ +lemma card_triangles_piFinset (X Y Z : Finset G) (k : ℕ) : + #(triangles (Fintype.piFinset fun _ : Fin k ↦ X) (Fintype.piFinset fun _ ↦ Y) + (Fintype.piFinset fun _ ↦ Z)) = #(triangles X Y Z) ^ k := by + rw [← Fintype.card_piFinset_const] + symm + apply card_equiv ((Equiv.arrowProdEquivProdArrow _ _ _).trans + ((Equiv.refl _).prodCongr (Equiv.arrowProdEquivProdArrow _ _ _))) + simp [triangles, funext_iff, forall_and] + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/ZMod.lean b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/ZMod.lean new file mode 100644 index 0000000000..ef3d63c54c --- /dev/null +++ b/LeanPool/ArithmeticTriangleRemovalInVectorSpaces/ZMod.lean @@ -0,0 +1,208 @@ +/- +Copyright (c) 2026 Gabriel Dahia. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Dahia +-/ +module + +public import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Exponent +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Construction.LowerBound +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.DisjointTriangles.MaximalFamily +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.DisjointTriangles.TensorPower +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.Product +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.MulticoloredSumFree.TensorPower +import LeanPool.ArithmeticTriangleRemovalInVectorSpaces.Tightness.Exponent + +/-! +# The arithmetic triangle removal lemma in `Fin n → ZMod p` + +This file states the main results of Fox and Lovász, "A tight bound for Green's arithmetic +triangle removal lemma in vector spaces", in `Fin n → ZMod p`, where `N = p ^ n`. The three +theorems write out the triangles and multicolored sum-freeness in terms of Mathlib definitions. + +## Main statements + +* `card_le_rpow_one_sub_c_mul`: the Kleinberg–Sawin–Speyer bound `m ≤ p ^ ((1 - c p) * n)` for + multicolored sum-free families (Theorem 2 of Fox and Lovász). +* `div_pow_rpow_C_mul_sq_le_card_triangles`: `m` vertex-disjoint triangles span at least + `(m / N) ^ C p * N ^ 2` triangles (Theorem 3). +* `exists_subset_card_sdiff_add_le_forall_add_ne_zero`: the arithmetic triangle removal lemma + with `δ = (ε / 3) ^ C p` (Theorem 1). +* `IsMulticoloredSumFree.card_triangles_prod_pi` and + `IsMulticoloredSumFree.triangles_prod_pi_nonempty`: the construction of Section 3, which shows + that the exponent `C p` cannot be lowered. +* `IsMulticoloredSumFree.mul_sq_le_card_of_forall_exists_subset`: if the removal lemma holds with + `ε` and `δ`, then every multicolored sum-free family of more than `ε * N` triples has at least + `δ * N ^ 2` members. +* `le_rpow_C_sub_of_forall_exists_subset`: `δ ≤ ε ^ (C p - η)` whenever `ε` and `δ` work in the + removal lemma and `0 < ε < ε₀ p η` (the "Furthermore" part of Theorem 1). It uses the + multicolored sum-free families of size `p ^ ((1 - c p - η') * n)` for `n ≥ n₀ p η'` of + `exists_isMulticoloredSumFree_rpow_le` (the second part of Theorem 2). +-/ + +public section + +open Finset Function + +namespace ArithmeticTriangleRemovalInVectorSpaces + +variable {p n : ℕ} [Fact p.Prime] + +/-- **The Kleinberg–Sawin–Speyer bound** (Theorem 2 of Fox and Lovász). If the triples +`(x i, y i, z i)` in `Fin n → ZMod p` satisfy `x i + y j + z k = 0` exactly when `i = j = k`, then +there are at most `p ^ ((1 - c p) * n)` of them. -/ +theorem card_le_rpow_one_sub_c_mul {ι : Type*} [Fintype ι] {x y z : ι → Fin n → ZMod p} + (h : ∀ i j k, x i + y j + z k = 0 ↔ i = j ∧ j = k) : + Fintype.card ι ≤ (p : ℝ) ^ ((1 - c p) * n) := by + have := IsMulticoloredSumFree.card_le_card_rpow (p := p) h + rwa [Fintype.card_fun, ZMod.card, Fintype.card_fin, Nat.cast_pow, ← Real.rpow_natCast, + ← Real.rpow_mul (Nat.cast_nonneg p), mul_comm] at this + +/-- **Theorem 3 of Fox and Lovász.** If `X × Y × Z` contains `m` vertex-disjoint triangles +`(x i, y i, z i)` in `Fin n → ZMod p`, then it contains at least `(m / N) ^ C p * N ^ 2` triangles, +where `N = p ^ n`. -/ +theorem div_pow_rpow_C_mul_sq_le_card_triangles {ι : Type*} [Fintype ι] + {x y z : ι → Fin n → ZMod p} {X Y Z : Finset (Fin n → ZMod p)} (hx : Injective x) + (hy : Injective y) (hz : Injective z) (hxX : ∀ i, x i ∈ X) (hyY : ∀ i, y i ∈ Y) + (hzZ : ∀ i, z i ∈ Z) (hsum : ∀ i, x i + y i + z i = 0) : + (Fintype.card ι / (p : ℝ) ^ n) ^ C p * (p ^ n) ^ 2 ≤ + #((X ×ˢ Y ×ˢ Z).filter fun (u, v, w) ↦ u + v + w = 0) := by + have := div_rpow_C_mul_sq_le_card_triangles (p := p) hx hy hz hxX hyY hzZ hsum + rwa [Fintype.card_fun, ZMod.card, Fintype.card_fin, Nat.cast_pow] at this + +/-- **Theorem 1 of Fox and Lovász: the arithmetic triangle removal lemma.** If `X × Y × Z` has +fewer than `(ε / 3) ^ C p * N ^ 2` triangles `x + y + z = 0` in `Fin n → ZMod p`, where `N = p ^ n`, +then removing at most `ε * N` elements from `X`, `Y` and `Z` leaves no triangle. -/ +theorem exists_subset_card_sdiff_add_le_forall_add_ne_zero {ε : ℝ} (hε : 0 ≤ ε) + {X Y Z : Finset (Fin n → ZMod p)} + (h : #((X ×ˢ Y ×ˢ Z).filter fun (x, y, z) ↦ x + y + z = 0) < (ε / 3) ^ C p * (p ^ n) ^ 2) : + ∃ X' ⊆ X, ∃ Y' ⊆ Y, ∃ Z' ⊆ Z, #(X \ X') + #(Y \ Y') + #(Z \ Z') ≤ ε * p ^ n ∧ + ∀ x ∈ X', ∀ y ∈ Y', ∀ z ∈ Z', x + y + z ≠ 0 := by + have hN : (Fintype.card (Fin n → ZMod p) : ℝ) = p ^ n := by simp + obtain ⟨X', hX', Y', hY', Z', hZ', hcard, hempty⟩ := + exists_subset_card_sdiff_add_le_of_card_triangles_lt (X := X) (Y := Y) (Z := Z) hε + (by rwa [hN]) + exact ⟨X', hX', Y', hY', Z', hZ', by rwa [← hN], triangles_eq_empty_iff.1 hempty⟩ + +variable {l : ℕ} {ι : Type*} [Fintype ι] {x y z : ι → Fin n → ZMod p} + +/-- **The construction of Section 3 of Fox and Lovász, part one.** For a multicolored sum-free +family of `m` triples in `Fin n → ZMod p` with vertex sets `X`, `Y` and `Z`, the sets `X × W`, +`Y × W` and `Z × W` with `W = Fin l → ZMod p` contain `m * p ^ (2 * l)` triangles. -/ +private lemma IsMulticoloredSumFree.card_triangles_prod_pi (h : IsMulticoloredSumFree x y z) : + #(triangles (univ.image x ×ˢ (univ : Finset (Fin l → ZMod p))) (univ.image y ×ˢ univ) + (univ.image z ×ˢ univ)) = Fintype.card ι * p ^ (2 * l) := by + rw [h.card_triangles_prod, Fintype.card_fun, ZMod.card, Fintype.card_fin, ← pow_mul, + mul_comm l] + +/-- **The construction of Section 3 of Fox and Lovász, part two.** Removing fewer than +`m * p ^ l` elements from the sets `X × W`, `Y × W` and `Z × W` of +`card_triangles_prod_pi` leaves a triangle. -/ +private lemma IsMulticoloredSumFree.triangles_prod_pi_nonempty (h : IsMulticoloredSumFree x y z) + {X' Y' Z' : Finset ((Fin n → ZMod p) × (Fin l → ZMod p))} + (hcard : #((univ.image x ×ˢ univ) \ X') + #((univ.image y ×ˢ univ) \ Y') + + #((univ.image z ×ˢ univ) \ Z') < Fintype.card ι * p ^ l) : + (triangles X' Y' Z').Nonempty := by + refine h.triangles_nonempty ?_ + rwa [Fintype.card_fun, ZMod.card, Fintype.card_fin] + +omit [Fact p.Prime] in +/-- **Tightness of the arithmetic triangle removal lemma** (Section 3 of Fox and Lovász). Suppose +that in `Fin n → ZMod p` every `X × Y × Z` with fewer than `δ * N ^ 2` triangles can be made +triangle-free by removing at most `ε * N` elements, where `N = p ^ n`. Then every multicolored +sum-free family of more than `ε * N` triples has at least `δ * N ^ 2` members. With the +Kleinberg–Sawin–Speyer families of size `p ^ ((1 - c p) * n - o(n))` of Norin and Pebody, this gives +`δ ≤ ε ^ (C p - o(1))`. -/ +private lemma IsMulticoloredSumFree.mul_sq_le_card_of_forall_exists_subset {ε δ : ℝ} + (h : IsMulticoloredSumFree x y z) (hε : ε * p ^ n < Fintype.card ι) + (hδ : ∀ X Y Z : Finset (Fin n → ZMod p), + #((X ×ˢ Y ×ˢ Z).filter fun (x, y, z) ↦ x + y + z = 0) < δ * (p ^ n) ^ 2 → + ∃ X' ⊆ X, ∃ Y' ⊆ Y, ∃ Z' ⊆ Z, #(X \ X') + #(Y \ Y') + #(Z \ Z') ≤ ε * p ^ n ∧ + ∀ x ∈ X', ∀ y ∈ Y', ∀ z ∈ Z', x + y + z ≠ 0) : + δ * (p ^ n) ^ 2 ≤ Fintype.card ι := by + by_contra! hlt + obtain ⟨X', -, Y', -, Z', -, hcard, hempty⟩ := hδ _ _ _ (by rwa [← triangles, + h.card_triangles_image]) + simpa [triangles_eq_empty_iff.2 hempty] using triangles_nonempty_of_card_sdiff_add_lt + (X := X') (Y := Y') (Z := Z') h.injective_left h.injective_middle h.injective_right + (fun i ↦ (h i i i).2 ⟨rfl, rfl⟩) (by exact_mod_cast hcard.trans_lt hε) + +omit [Fact p.Prime] in +/-- If the removal lemma holds in `Fin n → ZMod p` with `ε` and `δ`, and some multicolored +sum-free family has more than `ε * N` members, where `N = p ^ n`, then `δ * N ^ 2 ≤ ε * N + 1`. -/ +private lemma IsMulticoloredSumFree.mul_sq_le_mul_add_one {ε δ : ℝ} + (h : IsMulticoloredSumFree x y z) (hε0 : 0 ≤ ε) (hε : ε * p ^ n < Fintype.card ι) + (hδ : ∀ X Y Z : Finset (Fin n → ZMod p), + #((X ×ˢ Y ×ˢ Z).filter fun (x, y, z) ↦ x + y + z = 0) < δ * (p ^ n) ^ 2 → + ∃ X' ⊆ X, ∃ Y' ⊆ Y, ∃ Z' ⊆ Z, #(X \ X') + #(Y \ Y') + #(Z \ Z') ≤ ε * p ^ n ∧ + ∀ x ∈ X', ∀ y ∈ Y', ∀ z ∈ Z', x + y + z ≠ 0) : + δ * (p ^ n) ^ 2 ≤ ε * p ^ n + 1 := by + obtain ⟨f⟩ := Function.Embedding.nonempty_of_card_le (α := Fin (⌊ε * p ^ n⌋₊ + 1)) (β := ι) + (by rw [Fintype.card_fin]; exact (Nat.floor_lt (by positivity)).2 hε) + grw [(h.comp f.injective).mul_sq_le_card_of_forall_exists_subset ?_ hδ] + · rw [Fintype.card_fin] + push_cast + linarith [Nat.floor_le (by positivity : 0 ≤ ε * p ^ n)] + · rw [Fintype.card_fin] + exact_mod_cast Nat.lt_floor_add_one (ε * p ^ n) + +/-- The asymptotic tightness bound for fixed `κ` and `η'` with `1 ≤ κ`, `1 / c p - η / 2 ≤ κ` +and `0 < η' < 1 / κ - c p`, for `0 < ε < p ^ (-(n₀ p η' + 1))` and +`ε ≤ (p + p ^ 2) ^ (-2 / η)`. -/ +private lemma le_rpow_C_sub_of_lt {η κ η' ε δ : ℝ} (hη : 0 < η) (hκ₁ : 1 ≤ κ) + (hκη : (c p)⁻¹ - η / 2 ≤ κ) (hη'₀ : 0 < η') (hη' : η' < κ⁻¹ - c p) (hε0 : 0 < ε) + (hε : ε < ((p : ℝ) ^ (n₀ p η' + 1))⁻¹) (hε' : ε ≤ (p + p ^ 2 : ℝ)⁻¹ ^ (2 / η)) + (hδ : ∀ n (X Y Z : Finset (Fin n → ZMod p)), + #((X ×ˢ Y ×ˢ Z).filter fun (x, y, z) ↦ x + y + z = 0) < δ * (p ^ n) ^ 2 → + ∃ X' ⊆ X, ∃ Y' ⊆ Y, ∃ Z' ⊆ Z, #(X \ X') + #(Y \ Y') + #(Z \ Z') ≤ ε * p ^ n ∧ + ∀ x ∈ X', ∀ y ∈ Y', ∀ z ∈ Z', x + y + z ≠ 0) : + δ ≤ ε ^ (C p - η) := by + have hp₀ := (Fact.out : p.Prime).pos + have hp : 1 < (p : ℝ) := Nat.one_lt_cast.2 (Fact.out : p.Prime).one_lt + have hεκ : ε < (((p : ℝ) ^ κ⁻¹) ^ (n₀ p η' + 1))⁻¹ := by + grw [Real.rpow_le_self_of_one_le hp.le (inv_le_one_of_one_le₀ hκ₁)] + exact hε + obtain ⟨n, hn, hpow, hpow'⟩ := + exists_lt_pow_le_inv_lt (Real.one_lt_rpow hp (by positivity)) hε0 hεκ + have hε₁ : ε ≤ 1 := hε.le.trans (inv_le_one_of_one_le₀ (one_le_pow₀ hp.le)) + obtain ⟨m, x, y, z, hxyz, hm⟩ := + exists_isMulticoloredSumFree_rpow_le (Fact.out : p.Prime).two_le hη'₀ hn.le + have := hxyz.mul_sq_le_mul_add_one hε0.le (by + rw [Fintype.card_fin] + exact mul_pow_lt_of_rpow_mul_le hp hε0 (by grind) (by linarith) hpow hm) (hδ n) + grw [le_mul_rpow_one_add_of_mul_sq_le (by positivity) (by positivity) hε0 hε₁ hκ₁ + (inv_pow_le_mul_rpow (by positivity) hε0 (by positivity) hpow') this] + exact mul_rpow_le_rpow_sub (by positivity) hε0 hε₁ hη (by rw [C, one_div]; linarith) hε' + +private lemma ε₀_pos (η : ℝ) : 0 < ε₀ p η := by + have := (Fact.out : p.Prime).pos + rw [ε₀] + positivity + +/-- **Asymptotic tightness of the arithmetic triangle removal lemma** (the "Furthermore" part of +Theorem 1 of Fox and Lovász). For every `η > 0` and every `0 < ε < ε₀ p η`, any `δ` that works +with `ε` in the removal lemma in `Fin n → ZMod p` for every `n` satisfies `δ ≤ ε ^ (C p - η)`. +Here `ε₀ p η = p ^ (-(n₀ p η' + 1))` with `η' = c p * min (1 - c p) (c p * η / 2) / 2` and +`n₀ p η' = ⌈(2 ^ (p + 3) * p ^ 10 / η') ^ 2⌉ + p ^ 4 + 1`. The proof combines the construction of +Section 3 with the multicolored sum-free families of size `p ^ ((1 - c p - η') * n)` of Kleinberg, +Sawin and Speyer. -/ +theorem le_rpow_C_sub_of_forall_exists_subset {η ε δ : ℝ} (hη : 0 < η) (hε : 0 < ε) + (hε₀ : ε < ε₀ p η) + (hδ : ∀ n (X Y Z : Finset (Fin n → ZMod p)), + #((X ×ˢ Y ×ˢ Z).filter fun (x, y, z) ↦ x + y + z = 0) < δ * (p ^ n) ^ 2 → + ∃ X' ⊆ X, ∃ Y' ⊆ Y, ∃ Z' ⊆ Z, #(X \ X') + #(Y \ Y') + #(Z \ Z') ≤ ε * p ^ n ∧ + ∀ x ∈ X', ∀ y ∈ Y', ∀ z ∈ Z', x + y + z ≠ 0) : + δ ≤ ε ^ (C p - η) := by + have hp : (2 : ℝ) ≤ p := by exact_mod_cast (Fact.out : p.Prime).two_le + have hc := c_pos (Fact.out : p.Prime).two_le + have hc₁ := c_lt_one (Fact.out : p.Prime).two_le + rw [ε₀] at hε₀ + refine le_rpow_C_sub_of_lt hη (le_max_left _ _) (le_max_right _ _) + (mul_min_div_two_pos hc hc₁ hη) (mul_min_div_two_lt_inv_max_sub hc hc₁ hη) hε hε₀ + (hε₀.le.trans (inv_pow_le_inv_add_sq_rpow hp hη ?_)) hδ + push_cast + linarith [div_le_sq_div_mul_min_div_two (X := 2 ^ (p + 3) * (p : ℝ) ^ 10) hc hc₁ hη + (one_le_mul_of_one_le_of_one_le (one_le_pow₀ (by norm_num)) (one_le_pow₀ (by linarith))), + sq_add_one_le_n₀ p (c p * min (1 - c p) (c p * η / 2) / 2)] + +end ArithmeticTriangleRemovalInVectorSpaces diff --git a/LeanPool/projects/arithmetic-triangle-removal-in-vector-spaces.yaml b/LeanPool/projects/arithmetic-triangle-removal-in-vector-spaces.yaml new file mode 100644 index 0000000000..15ba7493c9 --- /dev/null +++ b/LeanPool/projects/arithmetic-triangle-removal-in-vector-spaces.yaml @@ -0,0 +1,67 @@ +slug: arithmetic-triangle-removal-in-vector-spaces +title: A tight bound for Green's arithmetic triangle removal lemma in vector spaces +summary: Proves the arithmetic triangle removal lemma in F_p^n with the polynomial + bound of Fox and Lovász. If X × Y × Z contains fewer than (ε/3)^(C_p) N^2 + solutions of x + y + z = 0, where N = p^n, C_p = 1 + 1/c_p and c_p is the + Kleinberg–Sawin–Speyer exponent, then removing at most εN elements leaves none. + Also proves the Kleinberg–Sawin–Speyer slice-rank bound p^((1 - c_p) n) on + multicolored sum-free families, the lower bound (m/N)^(C_p) N^2 on the number of + triangles spanned by m vertex-disjoint triangles, and that the exponent C_p is + optimal, with an explicit threshold ε₀. The tightness construction formalizes + Pebody's coupling theorem for decreasing mass functions and the + Kleinberg–Sawin–Speyer construction of large multicolored sum-free families, + using Behrend's three-term-progression-free sets. +branch: additive combinatorics +entry_module: LeanPool.ArithmeticTriangleRemovalInVectorSpaces +authors: +- Gabriel Dahia +source: + title: A tight bound for Green's arithmetic triangle removal lemma in vector spaces + authors: + - Jacob Fox + - László Miklós Lovász + arxiv: '1606.01230' + url: https://github.com/gdahia/ArithmeticTriangleRemovalInVectorSpaces/tree/3bddc92e8027badc994ba8993f7c625e60c7b13a + github_repo: gdahia/ArithmeticTriangleRemovalInVectorSpaces + commit: 3bddc92e8027badc994ba8993f7c625e60c7b13a +license: Apache-2.0 +status: verified +provenance: AI +main_declarations: +- ArithmeticTriangleRemovalInVectorSpaces.exists_subset_card_sdiff_add_le_forall_add_ne_zero +- ArithmeticTriangleRemovalInVectorSpaces.card_le_rpow_one_sub_c_mul +- ArithmeticTriangleRemovalInVectorSpaces.div_pow_rpow_C_mul_sq_le_card_triangles +- ArithmeticTriangleRemovalInVectorSpaces.le_rpow_C_sub_of_forall_exists_subset +main_results: +- declaration: ArithmeticTriangleRemovalInVectorSpaces.exists_subset_card_sdiff_add_le_forall_add_ne_zero + informal: For a prime p, ε ≥ 0 and X, Y, Z ⊆ F_p^n, if fewer than + (ε/3)^(C_p) p^(2n) triples (x, y, z) ∈ X × Y × Z satisfy x + y + z = 0, then + there are X' ⊆ X, Y' ⊆ Y, Z' ⊆ Z with |X \ X'| + |Y \ Y'| + |Z \ Z'| ≤ ε p^n + such that no triple in X' × Y' × Z' sums to zero. + source_ref: Theorem 1. +- declaration: ArithmeticTriangleRemovalInVectorSpaces.card_le_rpow_one_sub_c_mul + informal: For a prime p, a finite family of triples (x_i, y_i, z_i) in F_p^n with + x_i + y_j + z_k = 0 exactly when i = j = k has at most p^((1 - c_p) n) members, + where p^(1 - c_p) is the infimum over 0 < x < 1 of + x^(-(p-1)/3) (1 + x + ... + x^(p-1)). + source_ref: Theorem 2 (Kleinberg, Sawin and Speyer). +- declaration: ArithmeticTriangleRemovalInVectorSpaces.div_pow_rpow_C_mul_sq_le_card_triangles + informal: For a prime p and X, Y, Z ⊆ F_p^n, if X × Y × Z contains m + vertex-disjoint triples summing to zero, then it contains at least + (m/N)^(C_p) N^2 triples summing to zero, where N = p^n. + source_ref: Theorem 3. +- declaration: ArithmeticTriangleRemovalInVectorSpaces.le_rpow_C_sub_of_forall_exists_subset + informal: For a prime p, η > 0 and 0 < ε < ε₀(p, η), every δ such that, in every + dimension n, fewer than δ p^(2n) zero-sum triples can be destroyed by removing + ε p^n elements, satisfies δ ≤ ε^(C_p - η); ε₀ is an explicit function of p and η. + source_ref: Theorem 1, second part, via the construction of Section 3. +tags: +- additive-combinatorics +- removal-lemma +- slice-rank +- finite-fields +- sum-free-sets +msc: +- 11B30 +- 05D40 +- 11T99