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