/- THIRD-PARTY SOURCE, LICENSE, AND MODIFICATION NOTICE This file incorporates adapted source from Prime Number Theorem and More (PrimeNumberTheoremAnd), a collaborative project organized by Alex Kontorovich and Terence Tao, with contributions by the project's contributors. Upstream repository: https://github.com/AlexKontorovich/PrimeNumberTheoremAnd Upstream revision: a5154676af9aa3095150ee410cdda80555aa0642 Project citation: Alex Kontorovich and Terence Tao, Prime Number Theorem and More, version 0.1.0, project launched January 9, 2024; see upstream CITATION.cff. Adapted files, relative to the upstream PrimeNumberTheoremAnd directory: Wiener.lean Fourier.lean Sobolev.lean SmoothExistence.lean Mathlib/Analysis/Asymptotics/Asymptotics.lean Mathlib/Algebra/Notation/Support.lean MODIFICATIONS: These files were ported from Lean 4.32.2 to Lean 4.33.1 and the pinned Mathlib version; unused declarations and Architect/blueprint metadata were removed; declaration attributes, options, and instance registrations were replaced with ordinary definitions and closed concrete local dictionaries where needed; imports were supplied by the trusted wrapper and the retained source was flattened into this single file. The upstream authors are credited for that reused material, not represented as authors or endorsers of this Erdos 653 submission. The copied and adapted upstream material is distributed under Apache License 2.0. The complete upstream license follows. Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. -/ end Bounty -- Source: DistanceCounts/Core.lean section BodyFile000 /-! Positive pinned-distance counts and the epsilon formulation used by the construction. -/ noncomputable section namespace DistanceCounts /-- The genuine Euclidean plane, not the maximum-norm product `ℝ × ℝ`. -/ abbrev Point := EuclideanSpace ℝ (Fin 2) /-- Distinct positive distances from a pin to the other points of a finite set. -/ def distanceValues (X : Finset Point) (p : Point) : Finset ℝ := by classical exact (X.erase p).image (fun q => dist p q) /-- The number of distance values, rather than the number of neighbours. -/ def pinnedCount (X : Finset Point) (p : Point) : ℕ := (distanceValues X p).card /-- The set of distinct pinned-distance counts occurring in a configuration. -/ def countSpectrum (X : Finset Point) : Finset ℕ := by classical exact X.image (pinnedCount X) /-- The cardinality maximized in the question. -/ def diversity (X : Finset Point) : ℕ := (countSpectrum X).card /-- The epsilon formulation of the question, exactly as stated by the user. -/ def Erdos653 : Prop := ∀ ε : ℝ, 0 < ε → ∃ N : ℕ, ∀ n : ℕ, N ≤ n → ∃ X : Finset Point, X.card = n ∧ (1 - ε) * (n : ℝ) ≤ (diversity X : ℝ) /-- Coordinate formula useful for algebraic control-point calculations. -/ def sqDist (p q : Point) : ℝ := (p 0 - q 0) ^ 2 + (p 1 - q 1) ^ 2 end DistanceCounts end end BodyFile000 -- Source: DistanceCounts/GaussianNorm.lean section BodyFile001 /-! Inert-prime residues and exact denominators of rational squared distances. -/ noncomputable section namespace DistanceCounts.GaussianNorm /-- The actual Gaussian residue class, not a coordinatewise surrogate. -/ def residue (p : ℕ) (z : GaussianInt) : GaussianInt ⧸ Ideal.span ({(p : GaussianInt)} : Set GaussianInt) := Ideal.Quotient.mk _ z /-- Being nonzero modulo a rational integer is exactly Gaussian nondivisibility. -/ theorem residue_ne_zero_iff (p : ℕ) (z : GaussianInt) : residue p z ≠ 0 ↔ ¬(p : GaussianInt) ∣ z := by simp only [residue, ne_eq, Ideal.Quotient.eq_zero_iff_mem, Ideal.mem_span_singleton] /-- Adding an integer-grid difference to `z/q` preserves every residue at a prime factor of `q`. This is the arithmetic uniformity over pins in §3.3. -/ theorem residue_add_denominator_mul (p q : ℕ) (hpq : p ∣ q) (z w : GaussianInt) : residue p (z + (q : GaussianInt) * w) = residue p z := by apply Ideal.Quotient.eq.2 apply Ideal.mem_span_singleton.2 have hcast : (p : GaussianInt) ∣ (q : GaussianInt) := by obtain ⟨k, hk⟩ := hpq exact ⟨(k : GaussianInt), by exact_mod_cast hk⟩ simpa only [add_sub_cancel_left] using dvd_mul_of_dvd_left hcast w /-- An inert rational prime divides a Gaussian norm precisely when it divides its Gaussian argument. The forward implication uses primality and conjugation. -/ theorem inert_dvd_norm_iff (p : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) (z : GaussianInt) : (p : ℤ) ∣ z.norm ↔ (p : GaussianInt) ∣ z := by have hprime : Prime (p : GaussianInt) := @GaussianInt.prime_of_nat_prime_of_mod_four_eq_three p ⟨hp⟩ hp3 constructor · intro h have hc : (p : GaussianInt) ∣ (z.norm : GaussianInt) := by simpa only [Int.cast_natCast] using (Zsqrtd.intCast_dvd_intCast (p : ℤ) z.norm).2 h rw [Zsqrtd.norm_eq_mul_conj] at hc rcases hprime.dvd_or_dvd hc with hz | hz · exact hz · obtain ⟨w, hw⟩ := hz refine ⟨star w, ?_⟩ simpa [mul_comm] using congrArg star hw · intro h apply (Zsqrtd.intCast_dvd_intCast (p : ℤ) z.norm).1 change (p : GaussianInt) ∣ (z.norm : GaussianInt) rw [Zsqrtd.norm_eq_mul_conj] exact dvd_mul_of_dvd_left h (star z) /-- The natural-valued norm version used by rational reduction. -/ theorem inert_dvd_natNorm_iff (p : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) (z : GaussianInt) : p ∣ z.norm.natAbs ↔ (p : GaussianInt) ∣ z := by rw [← Int.natCast_dvd, inert_dvd_norm_iff p hp hp3 z] /-- An inverse modulo an inert prime forces a nonzero Gaussian residue. -/ theorem not_dvd_of_inverse_residue (p : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) (z w : GaussianInt) (hw : (p : GaussianInt) ∣ z * w - 1) : ¬(p : GaussianInt) ∣ z := by intro hz have hprime : Prime (p : GaussianInt) := @GaussianInt.prime_of_nat_prime_of_mod_four_eq_three p ⟨hp⟩ hp3 exact hprime.not_dvd_one ((dvd_sub_right (dvd_mul_of_dvd_left hz w)).1 hw) /-- A unit in the quotient ring provides the required inverse congruence. -/ theorem not_dvd_of_isUnit_residue (p : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) (z : GaussianInt) (hz : IsUnit (residue p z)) : ¬(p : GaussianInt) ∣ z := by obtain ⟨u, hu⟩ := hz.exists_right_inv obtain ⟨w, hw⟩ := Ideal.Quotient.mk_surjective u have hzw : residue p (z * w) = 1 := by change Ideal.Quotient.mk _ (z * w) = 1 rw [map_mul, hw] exact hu apply not_dvd_of_inverse_residue p hp hp3 z w exact Ideal.mem_span_singleton.1 ((Ideal.Quotient.mk_eq_one_iff_sub_mem (z * w)).1 hzw) /-- Coprimality follows from the nonzero residues at all inert prime factors. No squarefreeness is needed for this particular implication. -/ theorem coprime_norm_of_inert_factors (z : GaussianInt) (q : ℕ) (h : ∀ p, p.Prime → p ∣ q → p % 4 = 3 ∧ ¬(p : GaussianInt) ∣ z) : Nat.Coprime z.norm.natAbs q := by apply Nat.Coprime.symm apply Nat.coprime_of_dvd intro p hp hpq hpn exact (h p hp hpq).2 ((inert_dvd_natNorm_iff p hp (h p hp hpq).1 z).1 hpn) /-- The squarefree denominator setting: a finite set of distinct inert primes. -/ theorem coprime_norm_prime_product (S : Finset ℕ) (z : GaussianInt) (hprime : ∀ p ∈ S, p.Prime) (hinert : ∀ p ∈ S, p % 4 = 3) (hres : ∀ p ∈ S, ¬(p : GaussianInt) ∣ z) : Nat.Coprime z.norm.natAbs (∏ p ∈ S, p) := by apply Nat.Coprime.prod_right intro p hp apply Nat.Coprime.symm apply (hprime p hp).coprime_iff_not_dvd.2 intro hpn exact hres p hp ((inert_dvd_natNorm_iff p (hprime p hp) (hinert p hp) z).1 hpn) /-- Nonzero residue classes are a sufficient input to the product lemma. -/ theorem coprime_norm_prime_product_of_nonzero (S : Finset ℕ) (z : GaussianInt) (hprime : ∀ p ∈ S, p.Prime) (hinert : ∀ p ∈ S, p % 4 = 3) (hres : ∀ p ∈ S, residue p z ≠ 0) : Nat.Coprime z.norm.natAbs (∏ p ∈ S, p) := coprime_norm_prime_product S z hprime hinert (fun p hp => (residue_ne_zero_iff p z).1 (hres p hp)) /-- Unit residue classes give the same exact coprimality conclusion. -/ theorem coprime_norm_prime_product_of_units (S : Finset ℕ) (z : GaussianInt) (hprime : ∀ p ∈ S, p.Prime) (hinert : ∀ p ∈ S, p % 4 = 3) (hres : ∀ p ∈ S, IsUnit (residue p z)) : Nat.Coprime z.norm.natAbs (∏ p ∈ S, p) := coprime_norm_prime_product S z hprime hinert (fun p hp => not_dvd_of_isUnit_residue p (hprime p hp) (hinert p hp) z (hres p hp)) /-- The squared length of a Gaussian rational vector with denominator `q`. -/ def normQuotient (z : GaussianInt) (q : ℕ) : ℚ := (z.norm : ℚ) / (q : ℚ) ^ 2 /-- The displayed denominator is already reduced; this includes the integral case `q = 1` and does not require the numerator to be positive. -/ theorem normQuotient_den (z : GaussianInt) (q : ℕ) (hq : 0 < q) (hcop : Nat.Coprime z.norm.natAbs q) : (normQuotient z q).den = q ^ 2 := by have hcop2 : Nat.Coprime z.norm.natAbs ((q ^ 2 : ℕ) : ℤ).natAbs := by simpa only [Int.natAbs_natCast] using hcop.pow_right 2 have hden := Rat.den_div_eq_of_coprime (a := z.norm) (b := ((q ^ 2 : ℕ) : ℤ)) (by positivity) hcop2 have heq : normQuotient z q = Rat.divInt z.norm ((q ^ 2 : ℕ) : ℤ) := by simp only [normQuotient, Rat.divInt_eq_div, Int.cast_natCast, Nat.cast_pow, Int.cast_pow] rw [heq] exact_mod_cast hden /-- Every numerator in the prescribed residue class has the same exact squared denominator, regardless of the integer-grid displacement. -/ theorem normQuotient_den_prime_product_add_mul (S : Finset ℕ) (z w : GaussianInt) (hprime : ∀ p ∈ S, p.Prime) (hinert : ∀ p ∈ S, p % 4 = 3) (hres : ∀ p ∈ S, residue p z ≠ 0) : (normQuotient (z + ((∏ p ∈ S, p : ℕ) : GaussianInt) * w) (∏ p ∈ S, p)).den = (∏ p ∈ S, p) ^ 2 := by apply normQuotient_den · exact Finset.prod_pos (fun p hp => (hprime p hp).pos) · apply coprime_norm_prime_product_of_nonzero S _ hprime hinert intro p hp rw [residue_add_denominator_mul p (∏ p ∈ S, p) (Finset.dvd_prod_of_mem (fun p : ℕ => p) hp)] exact hres p hp /-- Equality of reduced squared lengths forces equality of their positive Gaussian-rational denominators. -/ theorem denominator_eq_of_normQuotient_eq (z w : GaussianInt) (q r : ℕ) (hq : 0 < q) (hr : 0 < r) (hz : Nat.Coprime z.norm.natAbs q) (hw : Nat.Coprime w.norm.natAbs r) (h : normQuotient z q = normQuotient w r) : q = r := by have hd := congrArg Rat.den h rw [normQuotient_den z q hq hz, normQuotient_den w r hr hw] at hd nlinarith /-- Passing to the real plane cannot identify different rational squared lengths. -/ theorem normQuotient_cast_eq_iff (z w : GaussianInt) (q r : ℕ) : (normQuotient z q : ℝ) = (normQuotient w r : ℝ) ↔ normQuotient z q = normQuotient w r := by constructor <;> intro h <;> exact_mod_cast h /-- Distinct positive denominators have disjoint real squared-length palettes. -/ theorem normQuotient_real_ne (z w : GaussianInt) (q r : ℕ) (hq : 0 < q) (hr : 0 < r) (hqr : q ≠ r) (hz : Nat.Coprime z.norm.natAbs q) (hw : Nat.Coprime w.norm.natAbs r) : (normQuotient z q : ℝ) ≠ (normQuotient w r : ℝ) := by intro h exact hqr (denominator_eq_of_normQuotient_eq z w q r hq hr hz hw ((normQuotient_cast_eq_iff z w q r).1 h)) /-- The full real palette at a fixed reduced denominator. -/ def squaredPalette (q : ℕ) : Set ℝ := {d | ∃ z : GaussianInt, Nat.Coprime z.norm.natAbs q ∧ d = (normQuotient z q : ℝ)} theorem squaredPalette_disjoint (q r : ℕ) (hq : 0 < q) (hr : 0 < r) (hqr : q ≠ r) : Disjoint (squaredPalette q) (squaredPalette r) := by apply Set.disjoint_left.2 rintro d ⟨z, hz, hdz⟩ ⟨w, hw, hdw⟩ exact normQuotient_real_ne z w q r hq hr hqr hz hw (hdz.symm.trans hdw) /-- Distinct sets of prime factors really give different product denominators. -/ theorem prime_product_ne (S T : Finset ℕ) (hS : ∀ p ∈ S, p.Prime) (hT : ∀ p ∈ T, p.Prime) (hne : S ≠ T) : (∏ p ∈ S, p) ≠ ∏ p ∈ T, p := by intro h apply hne have hf := congrArg Nat.primeFactors h simpa only [Nat.primeFactors_prod hS, Nat.primeFactors_prod hT] using hf /-- The exact denominator-prime-set separation invoked in Proof.md §4.1. -/ theorem prime_product_squaredPalette_disjoint (S T : Finset ℕ) (hS : ∀ p ∈ S, p.Prime) (hT : ∀ p ∈ T, p.Prime) (hne : S ≠ T) : Disjoint (squaredPalette (∏ p ∈ S, p)) (squaredPalette (∏ p ∈ T, p)) := by apply squaredPalette_disjoint · exact Finset.prod_pos (fun p hp => (hS p hp).pos) · exact Finset.prod_pos (fun p hp => (hT p hp).pos) · exact prime_product_ne S T hS hT hne /-- Coordinate differences of the form `z/q` have the rational norm quotient as their genuine Euclidean squared-distance formula. -/ theorem sqDist_eq_normQuotient (a b : DistanceCounts.Point) (z : GaussianInt) (q : ℕ) (hre : a 0 - b 0 = (z.re : ℝ) / q) (him : a 1 - b 1 = (z.im : ℝ) / q) : DistanceCounts.sqDist a b = (normQuotient z q : ℝ) := by simp only [DistanceCounts.sqDist, hre, him, normQuotient, Rat.cast_div, Rat.cast_intCast, Rat.cast_pow, Rat.cast_natCast, div_pow] rw [← add_div] congr 1 simp only [Zsqrtd.norm, Int.cast_sub, Int.cast_mul, Int.cast_neg, Int.cast_one] ring end DistanceCounts.GaussianNorm end end BodyFile001 -- Source: DistanceCounts/OffsetSeparation.lean section BodyFile002 /-! Prime-denominator separation. Integer arrays are unrestricted; all separation comes from the fixed rational offsets and their explicit nonzero residues. -/ noncomputable section open scoped BigOperators namespace DistanceCounts.OffsetSeparation /-- The actual rational vector represented by a Gaussian numerator. -/ def rationalOffset (z : GaussianInt) (p : ℕ) : ℚ × ℚ := ((z.re : ℚ) / p, (z.im : ℚ) / p) def integerVector (w : ℤ × ℤ) : ℚ × ℚ := ((w.1 : ℚ), (w.2 : ℚ)) /-- Clearing all denominators and reducing at one prime. No condition on the numerators is needed until the final prime cancellation. -/ theorem prime_dvd_numerator_of_integral_sum {I : Type*} [Fintype I] [DecidableEq I] (p : I → ℕ) (n : I → ℤ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (m : ℤ) (hm : (∑ i, (n i : ℚ) / p i) = m) (i : I) : (p i : ℤ) ∣ n i := by let D : ℤ := ∏ j, (p j : ℤ) let E : I → ℤ := fun j => ∏ k ∈ Finset.univ.erase j, (p k : ℤ) have hfactor (j : I) : (p j : ℤ) * E j = D := Finset.mul_prod_erase Finset.univ (fun k => (p k : ℤ)) (Finset.mem_univ j) have hclear : (∑ j, n j * E j) = m * D := by have hterm (j : I) : (n j : ℚ) / p j * (D : ℚ) = (n j * E j : ℤ) := by rw [← hfactor j] push_cast have hj : (p j : ℚ) ≠ 0 := by exact_mod_cast (hp j).ne_zero field_simp <;> ring have hh := congrArg (fun x : ℚ => x * (D : ℚ)) hm rw [Finset.sum_mul] at hh simp_rw [hterm] at hh exact_mod_cast hh have hD : (p i : ℤ) ∣ D := ⟨E i, (hfactor i).symm⟩ have hrest : (p i : ℤ) ∣ ∑ j ∈ Finset.univ.erase i, n j * E j := by apply Finset.dvd_sum intro j hj have hij : i ≠ j := (Finset.mem_erase.mp hj).1.symm have hE : (p i : ℤ) ∣ E j := Finset.dvd_prod_of_mem (fun k => (p k : ℤ)) (Finset.mem_erase.mpr ⟨hij, Finset.mem_univ i⟩) exact dvd_mul_of_dvd_right hE (n j) have hsum : (p i : ℤ) ∣ n i * E i := by have hall : (p i : ℤ) ∣ ∑ j, n j * E j := by rw [hclear] exact dvd_mul_of_dvd_right hD m rw [← Finset.add_sum_erase _ _ (Finset.mem_univ i)] at hall exact (dvd_add_left hrest).mp hall have hnot : ¬(p i : ℤ) ∣ E i := by apply (Nat.prime_iff_prime_int.mp (hp i)).not_dvd_finsetProd intro j hj hdiv have hnat : p i ∣ p j := by exact_mod_cast hdiv have heq := hd ((Nat.prime_dvd_prime_iff_eq (hp i) (hp j)).mp hnat) exact (Finset.mem_erase.mp hj).1 heq.symm exact ((Nat.prime_iff_prime_int.mp (hp i)).dvd_or_dvd hsum).resolve_right hnot /-- Scalar prime-denominator independence, with precisely the residue input required from arithmetic selection. -/ theorem scalar_integrality {I : Type*} [Fintype I] [DecidableEq I] (p : I → ℕ) (n c : I → ℤ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hn : ∀ i, ¬(p i : ℤ) ∣ n i) (h : ∃ m : ℤ, (∑ i, (c i : ℚ) * ((n i : ℚ) / p i)) = m) : ∀ i, (p i : ℤ) ∣ c i := by obtain ⟨m, hm⟩ := h intro i have heq : (∑ j, ((c j * n j : ℤ) : ℚ) / p j) = m := by simpa only [Int.cast_mul, mul_div_assoc] using hm exact ((Nat.prime_iff_prime_int.mp (hp i)).dvd_or_dvd (prime_dvd_numerator_of_integral_sum p (fun j => c j * n j) hp hd m heq i)).resolve_right (hn i) /-- Both integral coordinates force divisibility of every coefficient. In fact ordinary rational primality suffices: Gaussian nondivisibility says that at least one coordinate has nonzero residue. Thus this applies in particular to the explicit pairwise-distinct inert primes selected for the construction. -/ theorem rationalOffset_integrality {I : Type*} [Fintype I] [DecidableEq I] (p : I → ℕ) (z : I → GaussianInt) (c : I → ℤ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (h : ∃ w : ℤ × ℤ, (∑ i, (c i : ℚ) * (rationalOffset (z i) (p i)).1) = w.1 ∧ (∑ i, (c i : ℚ) * (rationalOffset (z i) (p i)).2) = w.2) : ∀ i, (p i : ℤ) ∣ c i := by obtain ⟨w, hre, him⟩ := h intro i have hr : (p i : ℤ) ∣ c i * (z i).re := by apply prime_dvd_numerator_of_integral_sum p (fun j => c j * (z j).re) hp hd w.1 simpa only [rationalOffset, Int.cast_mul, mul_div_assoc] using hre have hi : (p i : ℤ) ∣ c i * (z i).im := by apply prime_dvd_numerator_of_integral_sum p (fun j => c j * (z j).im) hp hd w.2 simpa only [rationalOffset, Int.cast_mul, mul_div_assoc] using him by_contra hc apply hz i have hcoords := And.intro (((Nat.prime_iff_prime_int.mp (hp i)).dvd_or_dvd hr).resolve_left hc) (((Nat.prime_iff_prime_int.mp (hp i)).dvd_or_dvd hi).resolve_left hc) simpa only [Int.cast_natCast] using (Zsqrtd.intCast_dvd (p i : ℤ) (z i)).mpr hcoords /-- Small coefficients cannot hide in the integer grid. -/ theorem rationalOffset_small_integrality {I : Type*} [Fintype I] [DecidableEq I] (p : I → ℕ) (z : I → GaussianInt) (c : I → ℤ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hc : ∀ i, |c i| < (p i : ℤ)) (h : ∃ w : ℤ × ℤ, (∑ i, (c i : ℚ) * (rationalOffset (z i) (p i)).1) = w.1 ∧ (∑ i, (c i : ℚ) * (rationalOffset (z i) (p i)).2) = w.2) : ∀ i, c i = 0 := by intro i apply Int.eq_zero_of_dvd_of_natAbs_lt_natAbs (rationalOffset_integrality p z c hp hd hz h i) have hh := hc i rw [← Int.natCast_natAbs] at hh exact_mod_cast hh /-- Signed multiplicity of an index in the difference of two pairs. -/ def pairCoefficient {I : Type*} [DecidableEq I] (i j a b k : I) : ℤ := (if k = i then 1 else 0) + (if k = j then 1 else 0) - (if k = a then 1 else 0) - (if k = b then 1 else 0) theorem pairCoefficient_bound {I : Type*} [DecidableEq I] (i j a b k : I) : |pairCoefficient i j a b k| ≤ 2 := by unfold pairCoefficient split_ifs <;> norm_num theorem pairCoefficient_sum {I : Type*} [Fintype I] [DecidableEq I] (r : I → ℚ) (i j a b : I) : (∑ k, (pairCoefficient i j a b k : ℚ) * r k) = r i + r j - r a - r b := by simp [pairCoefficient, Int.cast_add, Int.cast_sub, add_mul, sub_mul, Finset.sum_add_distrib, Finset.sum_sub_distrib, ite_mul] theorem pair_eq_of_coefficients_zero {I : Type*} [DecidableEq I] (i j a b : I) (h : ∀ k, pairCoefficient i j a b k = 0) : (i = a ∧ j = b) ∨ (i = b ∧ j = a) := by by_cases hia : i = a · left refine ⟨hia, ?_⟩ subst a have hb := h b by_contra hjb simp only [pairCoefficient] at hb split_ifs at hb <;> simp_all <;> omega · have hib : i = b := by by_contra hib have hi := h i simp only [pairCoefficient] at hi split_ifs at hi <;> simp_all <;> omega right refine ⟨hib, ?_⟩ subst b have ha := h a by_contra hja simp only [pairCoefficient] at ha split_ifs at ha <;> simp_all <;> omega /-- Fixed offsets determine the unordered pair even after arbitrary independent integer-grid displacements. Repeated same-side indices are allowed. -/ theorem offset_pair_separation {I : Type*} [Fintype I] [DecidableEq I] (p : I → ℕ) (z : I → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hlarge : ∀ i, 2 < p i) (i j a b : I) (v w : ℤ × ℤ) (heq : rationalOffset (z i) (p i) + rationalOffset (z j) (p j) + integerVector v = rationalOffset (z a) (p a) + rationalOffset (z b) (p b) + integerVector w) : (i = a ∧ j = b) ∨ (i = b ∧ j = a) := by apply pair_eq_of_coefficients_zero apply rationalOffset_small_integrality p z (pairCoefficient i j a b) hp hd hz · intro k have hk : (2 : ℤ) < p k := by exact_mod_cast hlarge k exact lt_of_le_of_lt (pairCoefficient_bound i j a b k) hk · refine ⟨(w.1 - v.1, w.2 - v.2), ?_, ?_⟩ · rw [pairCoefficient_sum] have hh := congrArg Prod.fst heq simp only [Prod.fst_add, integerVector] at hh push_cast linarith · rw [pairCoefficient_sum] have hh := congrArg Prod.snd heq simp only [Prod.snd_add, integerVector] at hh push_cast linarith /-- Inert primes automatically meet the small-coefficient bound. -/ theorem inert_gt_two (p : ℕ) (hp : p.Prime) (hinert : p % 4 = 3) : 2 < p := by have := hp.two_le omega /-- Physical offsets have the prescribed factor two, as do the grid coordinates. -/ def blockPoint {I : Type*} (p : I → ℕ) (z : I → GaussianInt) (i : I) (v : ℤ × ℤ) : ℚ × ℚ := (2 * ((rationalOffset (z i) (p i)).1 + v.1), 2 * ((rationalOffset (z i) (p i)).2 + v.2)) theorem block_pair_separation {I : Type*} [Fintype I] [DecidableEq I] (p : I → ℕ) (z : I → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (i j a b : I) (v t w : ℤ × ℤ) (heq : blockPoint p z i v + blockPoint p z j t = blockPoint p z a w + blockPoint p z b (0, 0)) : (i = a ∧ j = b) ∨ (i = b ∧ j = a) := by apply offset_pair_separation p z hp hd hz (fun k => inert_gt_two _ (hp k) (hinert k)) i j a b (v.1 + t.1, v.2 + t.2) w apply Prod.ext · have hh := congrArg Prod.fst heq simp only [blockPoint, Prod.fst_add] at hh simp only [Prod.fst_add, integerVector, Int.cast_add] norm_num at hh linarith · have hh := congrArg Prod.snd heq simp only [blockPoint, Prod.snd_add] at hh simp only [Prod.snd_add, integerVector, Int.cast_add] norm_num at hh linarith /-- Row and column primes live in one disjoint index type. Thus `hd` includes both within-side distinctness and cross-side disjointness of denominators. -/ theorem row_column_unique {A B : Type*} [Fintype A] [Fintype B] [DecidableEq A] [DecidableEq B] (p : A ⊕ B → ℕ) (z : A ⊕ B → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (i a : A) (j b : B) (v t w : ℤ × ℤ) (heq : blockPoint p z (.inl i) v + blockPoint p z (.inr j) t = blockPoint p z (.inl a) w + blockPoint p z (.inr b) (0, 0)) : i = a ∧ j = b := by have h := block_pair_separation p z hp hd hz hinert (.inl i) (.inr j) (.inl a) (.inr b) v t w heq simpa using h /-- Wrong blocks are excluded for every integer array, so exchanging any two arrays does not require moving or reselecting the offsets. -/ theorem wrong_block_exclusion {A B : Type*} [Fintype A] [Fintype B] [DecidableEq A] [DecidableEq B] (p : A ⊕ B → ℕ) (z : A ⊕ B → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (i a : A) (j b : B) (hwrong : i ≠ a ∨ j ≠ b) (v t w : ℤ × ℤ) : blockPoint p z (.inl i) v + blockPoint p z (.inr j) t ≠ blockPoint p z (.inl a) w + blockPoint p z (.inr b) (0, 0) := by intro heq have h := row_column_unique p z hp hd hz hinert i a j b v t w heq exact hwrong.elim (fun hne => hne h.1) (fun hne => hne h.2) theorem row_row_exclusion {A B : Type*} [Fintype A] [Fintype B] [DecidableEq A] [DecidableEq B] (p : A ⊕ B → ℕ) (z : A ⊕ B → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (i j a : A) (b : B) (v t w : ℤ × ℤ) : blockPoint p z (.inl i) v + blockPoint p z (.inl j) t ≠ blockPoint p z (.inl a) w + blockPoint p z (.inr b) (0, 0) := by intro heq have h := block_pair_separation p z hp hd hz hinert (.inl i) (.inl j) (.inl a) (.inr b) v t w heq simpa using h theorem column_column_exclusion {A B : Type*} [Fintype A] [Fintype B] [DecidableEq A] [DecidableEq B] (p : A ⊕ B → ℕ) (z : A ⊕ B → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (a : A) (i j b : B) (v t w : ℤ × ℤ) : blockPoint p z (.inr i) v + blockPoint p z (.inr j) t ≠ blockPoint p z (.inl a) w + blockPoint p z (.inr b) (0, 0) := by intro heq have h := block_pair_separation p z hp hd hz hinert (.inr i) (.inr j) (.inl a) (.inr b) v t w heq simpa using h /-- The integer numerator for the shared skew projection. Its nonvanishing modulo the associated prime is a separate, explicit arithmetic input. -/ def projectionNumerator (L : ℤ) (z : GaussianInt) : ℤ := L * z.re + z.im theorem projection_integrality {I : Type*} [Fintype I] [DecidableEq I] (p : I → ℕ) (z : I → GaussianInt) (L : ℤ) (c : I → ℤ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hres : ∀ i, ¬(p i : ℤ) ∣ projectionNumerator L (z i)) (h : ∃ m : ℤ, (∑ i, (c i : ℚ) * ((projectionNumerator L (z i) : ℚ) / p i)) = m) : ∀ i, (p i : ℤ) ∣ c i := scalar_integrality p (fun i => projectionNumerator L (z i)) c hp hd hres h theorem scalar_pair_separation {I : Type*} [Fintype I] [DecidableEq I] (p : I → ℕ) (n : I → ℤ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hn : ∀ i, ¬(p i : ℤ) ∣ n i) (hlarge : ∀ i, 2 < p i) (i j a b : I) (m : ℤ) (heq : (n i : ℚ) / p i + (n j : ℚ) / p j = (n a : ℚ) / p a + (n b : ℚ) / p b + m) : (i = a ∧ j = b) ∨ (i = b ∧ j = a) := by have hdiv := scalar_integrality p n (pairCoefficient i j a b) hp hd hn ⟨m, by rw [pairCoefficient_sum]; linarith⟩ apply pair_eq_of_coefficients_zero intro k apply Int.eq_zero_of_dvd_of_natAbs_lt_natAbs (hdiv k) have hh : |pairCoefficient i j a b k| < (p k : ℤ) := lt_of_le_of_lt (pairCoefficient_bound i j a b k) (by exact_mod_cast hlarge k) rw [← Int.natCast_natAbs] at hh exact_mod_cast hh /-- Projection of the physical row/column offset sum `U_a + V_b`. There is no integer-array term in this fixed label. -/ def sigma {A B : Type*} (p : A ⊕ B → ℕ) (z : A ⊕ B → GaussianInt) (L : ℤ) (a : A) (b : B) : ℚ := 2 * ((projectionNumerator L (z (.inl a)) : ℚ) / p (.inl a) + (projectionNumerator L (z (.inr b)) : ℚ) / p (.inr b)) theorem sigma_eq_projection {A B : Type*} (p : A ⊕ B → ℕ) (z : A ⊕ B → GaussianInt) (L : ℤ) (a : A) (b : B) : sigma p z L a b = (L : ℚ) * (blockPoint p z (.inl a) (0, 0) + blockPoint p z (.inr b) (0, 0)).1 + (blockPoint p z (.inl a) (0, 0) + blockPoint p z (.inr b) (0, 0)).2 := by simp only [sigma, projectionNumerator, blockPoint, rationalOffset, Prod.fst_add, Prod.snd_add, Int.cast_add, Int.cast_mul, Int.cast_zero, add_zero] ring /-- The scalar labels of distinct blocks are distinct even modulo integers. Use this separately at each desired skew `L`; neither residue hypothesis is inferred from Gaussian nondivisibility. -/ theorem sigma_unique_mod_integer {A B : Type*} [Fintype A] [Fintype B] [DecidableEq A] [DecidableEq B] (p : A ⊕ B → ℕ) (z : A ⊕ B → GaussianInt) (L : ℤ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hinert : ∀ i, p i % 4 = 3) (hres : ∀ i, ¬(p i : ℤ) ∣ projectionNumerator L (z i)) (a c : A) (b d : B) (m : ℤ) (heq : sigma p z L a b = sigma p z L c d + m) : a = c ∧ b = d := by have hn (i : A ⊕ B) : ¬(p i : ℤ) ∣ 2 * projectionNumerator L (z i) := by intro h rcases (Nat.prime_iff_prime_int.mp (hp i)).dvd_or_dvd h with htwo | hnum · have hnat : p i ∣ 2 := by exact_mod_cast htwo have hpeq := (Nat.prime_dvd_prime_iff_eq (hp i) Nat.prime_two).mp hnat have hbig := inert_gt_two _ (hp i) (hinert i) omega · exact hres i hnum have h := scalar_pair_separation p (fun i => 2 * projectionNumerator L (z i)) hp hd hn (fun i => inert_gt_two _ (hp i) (hinert i)) (.inl a) (.inr b) (.inl c) (.inr d) m (by push_cast dsimp [sigma] at heq linear_combination heq) simpa using h end DistanceCounts.OffsetSeparation end end BodyFile002 -- Source: DistanceCounts/Geometry.lean section BodyFile003 /-! Exact Euclidean identities and distant horizontal control lines. -/ noncomputable section namespace DistanceCounts /-- A coordinate constructor in the Euclidean (L²) plane. -/ def planePoint (x y : ℝ) : Point := !₂[x, y] theorem planePoint_zero (x y : ℝ) : planePoint x y 0 = x := rfl theorem planePoint_one (x y : ℝ) : planePoint x y 1 = y := rfl theorem planePoint_inj {x y a b : ℝ} : planePoint x y = planePoint a b ↔ x = a ∧ y = b := by constructor · intro h exact ⟨congrArg (fun p : Point => p 0) h, congrArg (fun p : Point => p 1) h⟩ · rintro ⟨rfl, rfl⟩ rfl /-- The coordinate expression is the square of the genuine Euclidean distance. -/ theorem sqDist_eq_dist_sq (p q : Point) : sqDist p q = dist p q ^ 2 := by rw [EuclideanSpace.dist_sq_eq] simp [sqDist, Fin.sum_univ_two, Real.dist_eq, sq_abs] theorem dist_eq_iff_sqDist_eq (p q r : Point) : dist p q = dist p r ↔ sqDist p q = sqDist p r := by rw [sqDist_eq_dist_sq, sqDist_eq_dist_sq] constructor · intro h rw [h] · intro h nlinarith [dist_nonneg (x := p) (y := q), dist_nonneg (x := p) (y := r)] theorem sqDist_planePoint (p : Point) (a h : ℝ) : sqDist p (planePoint a h) = (p 0 - a) ^ 2 + (p 1 - h) ^ 2 := rfl /-- Equality of distances on a horizontal line is precisely the midpoint relation, with the coincident-control case retained explicitly. -/ theorem horizontal_equidistant_iff (p : Point) (a b h : ℝ) : dist p (planePoint a h) = dist p (planePoint b h) ↔ a = b ∨ a + b = 2 * p 0 := by rw [dist_eq_iff_sqDist_eq] simp only [sqDist_planePoint] constructor · intro heq have hf : (a - b) * (a + b - 2 * p 0) = 0 := by nlinarith [heq] rcases mul_eq_zero.mp hf with hab | hab · left linarith · right linarith · rintro (hab | hab) · rw [hab] · have hb : b = 2 * p 0 - a := by linarith rw [hb] ring theorem horizontal_equidistant_iff_midpoint (p : Point) (a b h : ℝ) (hab : a ≠ b) : dist p (planePoint a h) = dist p (planePoint b h) ↔ a + b = 2 * p 0 := by rw [horizontal_equidistant_iff] exact or_iff_right hab /-- No distance class on a line contains three distinct controls. -/ theorem horizontal_distance_class_at_most_two (p : Point) (a b c h : ℝ) (hab : a ≠ b) (heq : dist p (planePoint a h) = dist p (planePoint b h)) (hc : dist p (planePoint c h) = dist p (planePoint a h)) : c = a ∨ c = b := by have hs := (horizontal_equidistant_iff_midpoint p a b h hab).mp heq rcases (horizontal_equidistant_iff p c a h).mp hc with hca | hca · exact Or.inl hca · exact Or.inr (by linarith) /-- The positive-distance convention is automatic after erasing the pin. -/ theorem distanceValues_pos {X : Finset Point} {p : Point} {r : ℝ} (hr : r ∈ distanceValues X p) : 0 < r := by classical obtain ⟨q, hq, rfl⟩ := Finset.mem_image.mp hr exact dist_pos.mpr (Finset.mem_erase.mp hq).1.symm /-- A horizontal line can be moved beyond any fixed distance from finitely many pins, uniformly in all its tangential coordinates. -/ theorem exists_far_horizontal_line (X : Finset Point) (R : ℝ) : ∃ h : ℝ, ∀ p ∈ X, ∀ a : ℝ, R < dist p (planePoint a h) := by classical let S : ℝ := ∑ p ∈ X, |p 1| refine ⟨S + |R| + 1, ?_⟩ intro p hp a have hpS : |p 1| ≤ S := Finset.single_le_sum (fun q _ => abs_nonneg (q 1)) hp have hpcoord : p 1 ≤ S := (le_abs_self _).trans hpS have hsq : (S + |R| + 1 - p 1) ^ 2 ≤ dist p (planePoint a (S + |R| + 1)) ^ 2 := by rw [← sqDist_eq_dist_sq, sqDist_planePoint] nlinarith [sq_nonneg (p 0 - a)] have hle := le_of_sq_le_sq hsq (dist_nonneg (x := p) (y := planePoint a (S + |R| + 1))) have := le_abs_self R linarith /-- Translating a control line avoids every old distance and every old point; its midpoint relations are unchanged by the chosen height. -/ theorem exists_horizontal_line_avoiding_old_distances (X : Finset Point) : ∃ h : ℝ, ∀ p ∈ X, ∀ a : ℝ, planePoint a h ∉ X ∧ dist p (planePoint a h) ∉ distanceValues X p := by classical let S : ℝ := ∑ p ∈ X, ‖p‖ have hbound : ∀ p ∈ X, ‖p‖ ≤ S := fun p hp => Finset.single_le_sum (fun q _ => norm_nonneg q) hp obtain ⟨h, hh⟩ := exists_far_horizontal_line X (2 * S) have hfar : ∀ p ∈ X, ∀ a : ℝ, ∀ y ∈ X, dist p y < dist p (planePoint a h) := by intro p hp a y hy have := hbound p hp have := hbound y hy have := dist_le_norm_add_norm p y have := hh p hp a linarith refine ⟨h, ?_⟩ intro p hp a constructor · intro ha exact (lt_irrefl _) (hfar p hp a (planePoint a h) ha) · intro hr obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp hr exact (ne_of_lt (hfar p hp a y (Finset.mem_erase.mp hy).2)) heq end DistanceCounts end end BodyFile003 -- Source: DistanceCounts/LineCount.lean section BodyFile004 /-! Exact midpoint collision counts and the Euclidean line-control extension identity. -/ noncomputable section namespace DistanceCounts /-- Distinct distances from the pin to scalar controls on one horizontal line. -/ def linePalette (p : Point) (A : Finset ℝ) (h : ℝ) : Finset ℝ := by classical exact A.image (fun a => dist p (planePoint a h)) /-- The distance palette of both scalar sides together. -/ def newLinePalette (p : Point) (A B : Finset ℝ) (h : ℝ) : Finset ℝ := by classical exact linePalette p (A ∪ B) h /-- Each pair has its first control on the left side and its second on the right. When the sides are disjoint, this counts each cross-side unordered pair once. -/ def crossMidpointPairs (p : Point) (A B : Finset ℝ) : Finset (ℝ × ℝ) := by classical exact (A.product B).filter (fun ab => ab.1 + ab.2 = 2 * p 0) theorem linePalette_distance_injOn (p : Point) (A : Finset ℝ) (h : ℝ) (hA : ∀ a ∈ A, ∀ b ∈ A, a ≠ b → a + b ≠ 2 * p 0) : Set.InjOn (fun a => dist p (planePoint a h)) (↑A : Set ℝ) := by intro a ha b hb heq rcases (horizontal_equidistant_iff p a b h).mp heq with hab | hab · exact hab · by_contra hne exact hA a ha b hb hne hab theorem linePalette_card (p : Point) (A : Finset ℝ) (h : ℝ) (hA : ∀ a ∈ A, ∀ b ∈ A, a ≠ b → a + b ≠ 2 * p 0) : (linePalette p A h).card = A.card := by classical exact Finset.card_image_of_injOn (linePalette_distance_injOn p A h hA) theorem newLinePalette_eq_union (p : Point) (A B : Finset ℝ) (h : ℝ) : newLinePalette p A B h = linePalette p A h ∪ linePalette p B h := by classical exact Finset.image_union A B /-- Cross midpoint pairs give precisely the distance values shared by the sides. -/ theorem crossMidpointPairs_image_eq_inter (p : Point) (A B : Finset ℝ) (h : ℝ) (hAB : Disjoint A B) : (crossMidpointPairs p A B).image (fun ab => dist p (planePoint ab.1 h)) = linePalette p A h ∩ linePalette p B h := by classical ext r constructor · intro hr obtain ⟨ab, hab, heq⟩ := Finset.mem_image.mp hr obtain ⟨hab, hmid⟩ := Finset.mem_filter.mp hab obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab have hdist := (horizontal_equidistant_iff p ab.1 ab.2 h).mpr (Or.inr hmid) exact Finset.mem_inter.mpr ⟨Finset.mem_image.mpr ⟨ab.1, ha, heq⟩, Finset.mem_image.mpr ⟨ab.2, hb, hdist.symm.trans heq⟩⟩ · intro hr obtain ⟨hra, hrb⟩ := Finset.mem_inter.mp hr obtain ⟨a, ha, har⟩ := Finset.mem_image.mp hra obtain ⟨b, hb, hbr⟩ := Finset.mem_image.mp hrb have hne : a ≠ b := by intro heq exact Finset.disjoint_left.mp hAB ha (heq.symm ▸ hb) have hmid : a + b = 2 * p 0 := (horizontal_equidistant_iff_midpoint p a b h hne).mp (har.trans hbr.symm) exact Finset.mem_image.mpr ⟨(a, b), Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨ha, hb⟩, hmid⟩, har⟩ /-- No two cross midpoint pairs represent the same distance value if the left side has no same-side collision. Their right coordinates are then forced. -/ theorem crossMidpointPairs_distance_injOn (p : Point) (A B : Finset ℝ) (h : ℝ) (hA : ∀ a ∈ A, ∀ b ∈ A, a ≠ b → a + b ≠ 2 * p 0) : Set.InjOn (fun ab : ℝ × ℝ => dist p (planePoint ab.1 h)) (↑(crossMidpointPairs p A B) : Set (ℝ × ℝ)) := by classical intro ab hab cd hcd heq obtain ⟨hab, habmid⟩ := Finset.mem_filter.mp hab obtain ⟨hcd, hcdmid⟩ := Finset.mem_filter.mp hcd have hfirst : ab.1 = cd.1 := linePalette_distance_injOn p A h hA (Finset.mem_product.mp hab).1 (Finset.mem_product.mp hcd).1 heq apply Prod.ext hfirst linarith theorem crossMidpointPairs_card_eq_inter (p : Point) (A B : Finset ℝ) (h : ℝ) (hAB : Disjoint A B) (hA : ∀ a ∈ A, ∀ b ∈ A, a ≠ b → a + b ≠ 2 * p 0) : (crossMidpointPairs p A B).card = (linePalette p A h ∩ linePalette p B h).card := by classical rw [← crossMidpointPairs_image_eq_inter p A B h hAB] exact (Finset.card_image_of_injOn (crossMidpointPairs_distance_injOn p A B h hA)).symm /-- Exact counting without natural-number subtraction: each cross-side midpoint pair accounts for one, and only one, lost distance value. -/ theorem newLinePalette_card_add_crossMidpointPairs_card (p : Point) (A B : Finset ℝ) (h : ℝ) (hAB : Disjoint A B) (hA : ∀ a ∈ A, ∀ b ∈ A, a ≠ b → a + b ≠ 2 * p 0) (hB : ∀ a ∈ B, ∀ b ∈ B, a ≠ b → a + b ≠ 2 * p 0) : (newLinePalette p A B h).card + (crossMidpointPairs p A B).card = A.card + B.card := by classical rw [newLinePalette_eq_union, crossMidpointPairs_card_eq_inter p A B h hAB hA, Finset.card_union_add_card_inter, linePalette_card p A h hA, linePalette_card p B h hB] /-- Erasing an old pin removes no control, so adjoining controls adjoins their whole palette to the old positive-distance palette. -/ theorem distanceValues_union_lineControls (X : Finset Point) (p : Point) (A B : Finset ℝ) (h : ℝ) (hp : p ∈ X) (hnew : Disjoint X ((A ∪ B).image (fun a => planePoint a h))) : distanceValues (X ∪ (A ∪ B).image (fun a => planePoint a h)) p = distanceValues X p ∪ newLinePalette p A B h := by classical have hpnew : p ∉ (A ∪ B).image (fun a => planePoint a h) := Finset.disjoint_left.mp hnew hp unfold distanceValues rw [Finset.erase_union_distrib, Finset.erase_eq_of_notMem hpnew, Finset.image_union, Finset.image_image] rfl /-- The pinned-distance extension identity for a genuine Euclidean configuration. The hypotheses separate within-line midpoint collisions from avoidance of every old positive distance. No subtraction or geometric avoidance assumption is hidden. -/ theorem pinnedCount_union_lineControls_add_crossMidpointPairs_card (X : Finset Point) (p : Point) (A B : Finset ℝ) (h : ℝ) (hp : p ∈ X) (hAB : Disjoint A B) (hA : ∀ a ∈ A, ∀ b ∈ A, a ≠ b → a + b ≠ 2 * p 0) (hB : ∀ a ∈ B, ∀ b ∈ B, a ≠ b → a + b ≠ 2 * p 0) (hnew : Disjoint X ((A ∪ B).image (fun a => planePoint a h))) (havoid : ∀ a ∈ A ∪ B, dist p (planePoint a h) ∉ distanceValues X p) : pinnedCount (X ∪ (A ∪ B).image (fun a => planePoint a h)) p + (crossMidpointPairs p A B).card = pinnedCount X p + A.card + B.card := by classical have hpalettes : Disjoint (distanceValues X p) (newLinePalette p A B h) := by apply Finset.disjoint_left.mpr intro r hr hline obtain ⟨a, ha, har⟩ := Finset.mem_image.mp hline exact havoid a ha (har.symm ▸ hr) have hcount : pinnedCount (X ∪ (A ∪ B).image (fun a => planePoint a h)) p = pinnedCount X p + (newLinePalette p A B h).card := by unfold pinnedCount rw [distanceValues_union_lineControls X p A B h hp hnew, Finset.card_union_of_disjoint hpalettes] rw [hcount, Nat.add_assoc, newLinePalette_card_add_crossMidpointPairs_card p A B h hAB hA hB, Nat.add_assoc] end DistanceCounts end end BodyFile004 -- Source: DistanceCounts/ObliqueLine.lean section BodyFile005 /-! Arbitrarily oriented Euclidean control lines and their exact extension count. -/ noncomputable section namespace DistanceCounts /-- The scalar tangential coordinate of a point in direction `v`. -/ def lineProjection (v p : Point) : ℝ := v 0 * p 0 + v 1 * p 1 /-- The squared length of the direction vector. -/ def lineNormSq (v : Point) : ℝ := v 0 ^ 2 + v 1 ^ 2 /-- The scalar coordinate in the perpendicular direction `(-v₁,v₀)`. -/ def normalProjection (v p : Point) : ℝ := -v 1 * p 0 + v 0 * p 1 /-- A genuine Euclidean point with tangential coordinate `t` and normal coordinate `h * lineNormSq v`. No normalization or isometry is assumed. -/ def obliquePoint (v : Point) (t h : ℝ) : Point := planePoint ((t / lineNormSq v) * v 0 - h * v 1) ((t / lineNormSq v) * v 1 + h * v 0) theorem lineNormSq_pos {v : Point} (hv : v ≠ 0) : 0 < lineNormSq v := by have hn : 0 ≤ lineNormSq v := add_nonneg (sq_nonneg _) (sq_nonneg _) by_contra h have hz : lineNormSq v = 0 := le_antisymm (le_of_not_gt h) hn have hzero : v 0 = 0 := by unfold lineNormSq at hz nlinarith [sq_nonneg (v 1)] have hone : v 1 = 0 := by unfold lineNormSq at hz nlinarith [sq_nonneg (v 0)] apply hv ext i fin_cases i · simpa using hzero · simpa using hone theorem lineProjection_obliquePoint {v : Point} (hv : v ≠ 0) (t h : ℝ) : lineProjection v (obliquePoint v t h) = t := by have hc : v 0 ^ 2 + v 1 ^ 2 ≠ 0 := (lineNormSq_pos hv).ne' dsimp [lineProjection, obliquePoint, lineNormSq, planePoint] field_simp [hc] <;> ring theorem obliquePoint_injective {v : Point} (hv : v ≠ 0) (h : ℝ) : Function.Injective (fun t => obliquePoint v t h) := by intro a b hab have heq := congrArg (lineProjection v) hab simpa only [lineProjection_obliquePoint hv] using heq /-- The exact squared-distance identity separates the tangential collision term from the common normal displacement. -/ theorem obliquePoint_sqDist_identity {v : Point} (hv : v ≠ 0) (p : Point) (t h : ℝ) : lineNormSq v * sqDist p (obliquePoint v t h) - (h * lineNormSq v - normalProjection v p) ^ 2 = (t - lineProjection v p) ^ 2 := by have hc : v 0 ^ 2 + v 1 ^ 2 ≠ 0 := (lineNormSq_pos hv).ne' dsimp [sqDist, obliquePoint, lineNormSq, normalProjection, lineProjection, planePoint] field_simp [hc] <;> ring /-- Equality of actual Euclidean distances has the same fibers as the horizontal line with pin coordinate `lineProjection v p`. -/ theorem oblique_equidistant_iff {v : Point} (hv : v ≠ 0) (p : Point) (a b h : ℝ) : dist p (obliquePoint v a h) = dist p (obliquePoint v b h) ↔ a = b ∨ a + b = 2 * lineProjection v p := by rw [dist_eq_iff_sqDist_eq] have ha := obliquePoint_sqDist_identity hv p a h have hb := obliquePoint_sqDist_identity hv p b h constructor · intro heq have hs : (a - lineProjection v p) ^ 2 = (b - lineProjection v p) ^ 2 := by rw [heq] at ha linarith have hf : (a - b) * (a + b - 2 * lineProjection v p) = 0 := by nlinarith [hs] rcases mul_eq_zero.mp hf with he | he · left linarith · right linarith · rintro (he | he) · rw [he] · have hs : (a - lineProjection v p) ^ 2 = (b - lineProjection v p) ^ 2 := by have he' : b = 2 * lineProjection v p - a := by linarith rw [he'] ring apply mul_left_cancel₀ (lineNormSq_pos hv).ne' linarith /-- A single normal shift puts the entire infinite control line beyond a prescribed radius from every point of a finite set. -/ theorem exists_far_oblique_line {v : Point} (hv : v ≠ 0) (X : Finset Point) (R : ℝ) : ∃ h : ℝ, ∀ p ∈ X, ∀ t : ℝ, R < dist p (obliquePoint v t h) := by classical let S : ℝ := ∑ p ∈ X, |normalProjection v p| let h : ℝ := (S + Real.sqrt (lineNormSq v) * (|R| + 1)) / lineNormSq v have hc := lineNormSq_pos hv have hh : h * lineNormSq v = S + Real.sqrt (lineNormSq v) * (|R| + 1) := by dsimp [h] exact div_mul_cancel₀ _ hc.ne' refine ⟨h, ?_⟩ intro p hp t have hpS : |normalProjection v p| ≤ S := Finset.single_le_sum (fun q _ => abs_nonneg (normalProjection v q)) hp have hpcoord : normalProjection v p ≤ S := (le_abs_self _).trans hpS have hn : 0 ≤ Real.sqrt (lineNormSq v) * (|R| + 1) := mul_nonneg (Real.sqrt_nonneg _) (by positivity) have hnormal : Real.sqrt (lineNormSq v) * (|R| + 1) ≤ h * lineNormSq v - normalProjection v p := by rw [hh]; linarith have hid := obliquePoint_sqDist_identity hv p t h rw [sqDist_eq_dist_sq] at hid have hsq : lineNormSq v * (|R| + 1) ^ 2 ≤ lineNormSq v * dist p (obliquePoint v t h) ^ 2 := by calc lineNormSq v * (|R| + 1) ^ 2 = (Real.sqrt (lineNormSq v) * (|R| + 1)) ^ 2 := by rw [mul_pow, Real.sq_sqrt hc.le] _ ≤ (h * lineNormSq v - normalProjection v p) ^ 2 := (sq_le_sq₀ hn (hn.trans hnormal)).mpr hnormal _ ≤ lineNormSq v * dist p (obliquePoint v t h) ^ 2 := by nlinarith [sq_nonneg (t - lineProjection v p)] have hle := le_of_sq_le_sq (le_of_mul_le_mul_left hsq hc) (dist_nonneg (x := p) (y := obliquePoint v t h)) have hR := le_abs_self R linarith /-- The chosen normal shift avoids every old point and every old positive pinned distance, uniformly over all tangential coordinates. -/ theorem exists_oblique_line_avoiding_old_distances {v : Point} (hv : v ≠ 0) (X : Finset Point) : ∃ h : ℝ, (∀ t : ℝ, obliquePoint v t h ∉ X) ∧ ∀ p ∈ X, ∀ t : ℝ, dist p (obliquePoint v t h) ∉ distanceValues X p := by classical let S : ℝ := ∑ p ∈ X, ‖p‖ have hS : 0 ≤ S := Finset.sum_nonneg (fun p _ => norm_nonneg p) have hbound : ∀ p ∈ X, ‖p‖ ≤ S := fun p hp => Finset.single_le_sum (fun q _ => norm_nonneg q) hp obtain ⟨h, hh⟩ := exists_far_oblique_line hv X (2 * S) refine ⟨h, ?_, ?_⟩ · intro t ht have hfar := hh (obliquePoint v t h) ht t rw [dist_self] at hfar linarith · intro p hp t hr obtain ⟨q, hq, heq⟩ := Finset.mem_image.mp hr have hpbound := hbound p hp have hqbound := hbound q (Finset.mem_erase.mp hq).2 have hdist := dist_le_norm_add_norm p q have hfar := hh p hp t linarith /-- Equal fibers, not equal numerical distance values, suffice to transfer image cardinality between two realizations of a finite scalar palette. -/ theorem card_image_eq_of_same_fibers {α β γ : Type*} [DecidableEq β] [DecidableEq γ] (S : Finset α) (f : α → β) (g : α → γ) (hfib : ∀ a b, f a = f b ↔ g a = g b) : (S.image f).card = (S.image g).card := by classical induction S using Finset.induction_on with | empty => simp | @insert a S ha ih => have hm : f a ∈ S.image f ↔ g a ∈ S.image g := by simp only [Finset.mem_image] constructor · rintro ⟨b, hb, heq⟩ exact ⟨b, hb, (hfib b a).mp heq⟩ · rintro ⟨b, hb, heq⟩ exact ⟨b, hb, (hfib b a).mpr heq⟩ rw [Finset.image_insert, Finset.image_insert] by_cases hf : f a ∈ S.image f · rw [Finset.insert_eq_of_mem hf, Finset.insert_eq_of_mem (hm.mp hf)] exact ih · rw [Finset.card_insert_of_notMem hf, Finset.card_insert_of_notMem (fun hg => hf (hm.mpr hg)), ih] /-- The oblique palette has exactly the cardinality of LineCount's horizontal palette at the projected pin, although their distance values differ. -/ theorem obliquePalette_card_eq_linePalette {v : Point} (hv : v ≠ 0) (p : Point) (A : Finset ℝ) (h k : ℝ) : (A.image (fun a => dist p (obliquePoint v a h))).card = (linePalette (planePoint (lineProjection v p) 0) A k).card := by classical apply card_image_eq_of_same_fibers intro a b rw [oblique_equidistant_iff hv, horizontal_equidistant_iff] rfl /-- Reuse the finite midpoint-pair count without repeating its combinatorics. -/ theorem obliquePalette_card_add_crossMidpointPairs_card {v : Point} (hv : v ≠ 0) (p : Point) (A B : Finset ℝ) (h : ℝ) (hAB : Disjoint A B) (hA : ∀ a ∈ A, ∀ b ∈ A, a ≠ b → a + b ≠ 2 * lineProjection v p) (hB : ∀ a ∈ B, ∀ b ∈ B, a ≠ b → a + b ≠ 2 * lineProjection v p) : ((A ∪ B).image (fun a => dist p (obliquePoint v a h))).card + (crossMidpointPairs (planePoint (lineProjection v p) 0) A B).card = A.card + B.card := by classical rw [obliquePalette_card_eq_linePalette hv p (A ∪ B) h 0] exact newLinePalette_card_add_crossMidpointPairs_card (planePoint (lineProjection v p) 0) A B 0 hAB hA hB /-- Actual Euclidean realization of the arbitrary-orientation line extension: all original points remain, all scalar controls add distinct new points, and one common normal shift gives the exact count simultaneously at every pin. -/ theorem exists_oblique_line_extension {v : Point} (hv : v ≠ 0) (P X : Finset Point) (A B : Finset ℝ) (hPX : P ⊆ X) (hAB : Disjoint A B) (hA : ∀ p ∈ P, ∀ a ∈ A, ∀ b ∈ A, a ≠ b → a + b ≠ 2 * lineProjection v p) (hB : ∀ p ∈ P, ∀ a ∈ B, ∀ b ∈ B, a ≠ b → a + b ≠ 2 * lineProjection v p) : ∃ Y : Finset Point, X ⊆ Y ∧ Y.card = X.card + A.card + B.card ∧ ∀ p ∈ P, pinnedCount Y p + (crossMidpointPairs (planePoint (lineProjection v p) 0) A B).card = pinnedCount X p + A.card + B.card := by classical obtain ⟨h, hnew, havoid⟩ := exists_oblique_line_avoiding_old_distances hv X let C : Finset Point := (A ∪ B).image (fun a => obliquePoint v a h) have hXC : Disjoint X C := by apply Finset.disjoint_left.mpr intro q hq hqc obtain ⟨a, ha, rfl⟩ := Finset.mem_image.mp hqc exact hnew a hq have hC : C.card = A.card + B.card := by rw [Finset.card_image_of_injective _ (obliquePoint_injective hv h), Finset.card_union_of_disjoint hAB] refine ⟨X ∪ C, Finset.subset_union_left, ?_, ?_⟩ · rw [Finset.card_union_of_disjoint hXC, hC, Nat.add_assoc] · intro p hp have hpX := hPX hp have hpC : p ∉ C := Finset.disjoint_left.mp hXC hpX have hvalues : distanceValues (X ∪ C) p = distanceValues X p ∪ (A ∪ B).image (fun a => dist p (obliquePoint v a h)) := by unfold distanceValues rw [Finset.erase_union_distrib, Finset.erase_eq_of_notMem hpC, Finset.image_union] dsimp [C] rw [Finset.image_image] rfl have hpal : Disjoint (distanceValues X p) ((A ∪ B).image (fun a => dist p (obliquePoint v a h))) := by apply Finset.disjoint_left.mpr intro r hr hrc obtain ⟨a, ha, har⟩ := Finset.mem_image.mp hrc exact havoid p hpX a (har.symm ▸ hr) have hcount : pinnedCount (X ∪ C) p = pinnedCount X p + ((A ∪ B).image (fun a => dist p (obliquePoint v a h))).card := by unfold pinnedCount rw [hvalues, Finset.card_union_of_disjoint hpal] rw [hcount, Nat.add_assoc, obliquePalette_card_add_crossMidpointPairs_card hv p A B h hAB (hA p hp) (hB p hp), Nat.add_assoc] /-- Irrational projection is injective on rational coordinate pairs. -/ theorem rational_sqrt_two_projection_injective : Function.Injective (fun q : ℚ × ℚ => (q.1 : ℝ) + Real.sqrt 2 * (q.2 : ℝ)) := by intro a b heq have hy : a.2 = b.2 := by by_contra hne have hd : (a.2 : ℝ) - (b.2 : ℝ) ≠ 0 := by intro hz apply hne exact_mod_cast (sub_eq_zero.mp hz) apply irrational_sqrt_two refine ⟨(b.1 - a.1) / (a.2 - b.2), ?_⟩ push_cast apply (div_eq_iff hd).mpr nlinarith [heq] apply Prod.ext ?_ hy have hy' : (a.2 : ℝ) = (b.2 : ℝ) := congrArg (fun q : ℚ => (q : ℝ)) hy have hx : (a.1 : ℝ) = (b.1 : ℝ) := by change (a.1 : ℝ) + Real.sqrt 2 * (a.2 : ℝ) = (b.1 : ℝ) + Real.sqrt 2 * (b.2 : ℝ) at heq rw [hy'] at heq exact add_right_cancel heq exact_mod_cast hx end DistanceCounts end end BodyFile005 -- Source: DistanceCounts/GridPairs.lean section BodyFile006 /-! Exact grid displacement counts and finite maximum-norm kernel estimates. -/ noncomputable section namespace DistanceCounts namespace GridPairs open Finset open scoped Classical abbrev Grid (L : ℕ) := Fin L × Fin L def displacement {L : ℕ} (p : Grid L × Grid L) : ℤ × ℤ := ((p.2.1 : ℤ) - p.1.1, (p.2.2 : ℤ) - p.1.2) def radius (d : ℤ × ℤ) : ℕ := max d.1.natAbs d.2.natAbs def rho (L : ℕ) (d : ℤ × ℤ) : ℝ := (radius d : ℝ) / L def multiplicity (L : ℕ) (d : ℤ × ℤ) : ℕ := (L - d.1.natAbs) * (L - d.2.natAbs) def coordinateFiber (L : ℕ) (d : ℤ) : Finset (Fin L × Fin L) := univ.filter (fun p => (p.2 : ℤ) - p.1 = d) lemma coordinateFiber_card (L : ℕ) (d : ℤ) : (coordinateFiber L d).card = L - d.natAbs := by classical have hcount : (coordinateFiber L d).card = (Ico (max 0 (-d)) (min (L : ℤ) (L - d))).card := by apply card_bij (fun p _ => (p.1 : ℤ)) · intro p hp have hp' := (mem_filter.mp hp).2 have h₁ := p.1.isLt have h₂ := p.2.isLt simp only [mem_Ico] omega · intro p hp q hq hpq have hp' := (mem_filter.mp hp).2 have hq' := (mem_filter.mp hq).2 apply Prod.ext <;> apply Fin.ext <;> omega · intro x hx simp only [mem_Ico] at hx have hx0 : 0 ≤ x := by omega have hy0 : 0 ≤ x + d := by omega let p : Fin L × Fin L := (⟨x.toNat, by omega⟩, ⟨(x + d).toNat, by omega⟩) have hp : p ∈ coordinateFiber L d := by simp only [coordinateFiber, mem_filter, mem_univ, true_and] dsimp [p] omega exact ⟨p, hp, by dsimp [p]; omega⟩ rw [hcount, Int.card_Ico] have hd := Int.natCast_natAbs d by_cases h : 0 ≤ d · rw [abs_of_nonneg h] at hd omega · rw [abs_of_neg (lt_of_not_ge h)] at hd omega /-- The histogram is derived from actual ordered pairs of grid points. -/ lemma multiplicity_eq_card (L : ℕ) (d : ℤ × ℤ) : multiplicity L d = (univ.filter (fun p : Grid L × Grid L => displacement p = d)).card := by classical have h : (univ.filter (fun p : Grid L × Grid L => displacement p = d)).card = ((coordinateFiber L d.1) ×ˢ (coordinateFiber L d.2)).card := by apply card_bij (fun p _ => ((p.1.1, p.2.1), (p.1.2, p.2.2))) · intro p hp have h := (mem_filter.mp hp).2 simpa [coordinateFiber, displacement] using (Prod.ext_iff.mp h) · intro p hp q hq h rcases p with ⟨⟨a,b⟩,⟨c,e⟩⟩ rcases q with ⟨⟨a',b'⟩,⟨c',e'⟩⟩ simpa only [Prod.mk.injEq, and_assoc, and_left_comm, and_comm] using h · intro p hp refine ⟨((p.1.1, p.2.1), (p.1.2, p.2.2)), ?_, rfl⟩ simpa [coordinateFiber, displacement, Prod.ext_iff] using hp rw [h, card_product, coordinateFiber_card, coordinateFiber_card] rfl def displacements (L : ℕ) : Finset (ℤ × ℤ) := univ.image (@displacement L) /-- Exact finite summation by displacement, with both diagonal and boundary multiplicities. -/ lemma sum_by_displacement (L : ℕ) (f : ℤ × ℤ → ℝ) : (∑ p : Grid L × Grid L, f (displacement p)) = ∑ d ∈ displacements L, (multiplicity L d : ℝ) * f d := by classical rw [← sum_fiberwise_of_maps_to (show Set.MapsTo (@displacement L) (univ : Finset (Grid L × Grid L)) (displacements L) from fun p hp => mem_image_of_mem _ hp)] apply sum_congr rfl intro d hd rw [multiplicity_eq_card] calc (∑ p ∈ univ.filter (fun p : Grid L × Grid L => displacement p = d), f (displacement p)) = ∑ _p ∈ univ.filter (fun p : Grid L × Grid L => displacement p = d), f d := by apply sum_congr rfl intro p hp rw [(mem_filter.mp hp).2] _ = _ := by simp lemma multiplicity_le (L : ℕ) (d : ℤ × ℤ) : multiplicity L d ≤ L ^ 2 := by unfold multiplicity calc (L - d.1.natAbs) * (L - d.2.natAbs) ≤ L * L := Nat.mul_le_mul (Nat.sub_le _ _) (Nat.sub_le _ _) _ = _ := by ring lemma radius_pos_iff (d : ℤ × ℤ) : 0 < radius d ↔ d ≠ 0 := by rcases d with ⟨x,y⟩ simp [radius, Int.natAbs_pos, Prod.ext_iff] tauto lemma radius_le_iff (d : ℤ × ℤ) (k : ℕ) : radius d ≤ k ↔ -(k : ℤ) ≤ d.1 ∧ d.1 ≤ k ∧ -(k : ℤ) ≤ d.2 ∧ d.2 ≤ k := by have hx := Int.natCast_natAbs d.1 have hy := Int.natCast_natAbs d.2 rw [abs_eq_max_neg] at hx hy simp only [radius, max_le_iff] omega def square (k : ℕ) : Finset (ℤ × ℤ) := (Icc (-(k : ℤ)) k) ×ˢ (Icc (-(k : ℤ)) k) lemma mem_square (d : ℤ × ℤ) (k : ℕ) : d ∈ square k ↔ radius d ≤ k := by simp only [square, mem_product, mem_Icc, radius_le_iff] tauto lemma square_card (k : ℕ) : (square k).card = (2 * k + 1) ^ 2 := by have h : ((k : ℤ) + 1 - -(k : ℤ)).toNat = 2 * k + 1 := by omega simp only [square, card_product, Int.card_Icc, h, pow_two] lemma square_mono {j k : ℕ} (h : j ≤ k) : square j ⊆ square k := by intro d hd rw [mem_square] at hd ⊢ omega def shell (k : ℕ) : Finset (ℤ × ℤ) := (square k).filter (fun d => radius d = k ∧ d ≠ 0) lemma mem_shell (d : ℤ × ℤ) (k : ℕ) : d ∈ shell k ↔ radius d = k ∧ d ≠ 0 := by simp only [shell, mem_filter, mem_square] exact ⟨fun h => h.2, fun h => ⟨h.1.le, h⟩⟩ lemma shell_eq_sdiff {k : ℕ} (hk : 0 < k) : shell k = square k \ square (k - 1) := by ext d rw [mem_shell, mem_sdiff, mem_square, mem_square, ← radius_pos_iff] omega /-- The exact maximum-norm shell count. -/ lemma shell_card (k : ℕ) : (shell k).card = 8 * k := by by_cases hk : k = 0 · subst k have h : shell 0 = ∅ := by ext d simp only [mem_shell, notMem_empty, iff_false] rintro ⟨hd, hd0⟩ have hpos := (radius_pos_iff d).mpr hd0 omega simp [h] · rw [shell_eq_sdiff (Nat.pos_of_ne_zero hk), card_sdiff_of_subset (square_mono (Nat.sub_le _ _)), square_card, square_card] have h : k - 1 + 1 = k := by omega have heq : (2 * k + 1) ^ 2 = (2 * (k - 1) + 1) ^ 2 + 8 * k := by nlinarith omega /-- Normalized singular sum over an arbitrary finite collection of displacements. The value at zero is defined to be zero; all estimates below exclude zero explicitly. -/ def kernelSum (L : ℕ) (s : Finset (ℤ × ℤ)) : ℝ := (∑ d ∈ s, (multiplicity L d : ℝ) / rho L d) / (L : ℝ) ^ 4 lemma kernelSum_nonneg (L : ℕ) (s : Finset (ℤ × ℤ)) : 0 ≤ kernelSum L s := by unfold kernelSum rho positivity lemma kernelSum_mono (L : ℕ) {s t : Finset (ℤ × ℤ)} (h : s ⊆ t) : kernelSum L s ≤ kernelSum L t := by apply div_le_div_of_nonneg_right _ (by positivity) exact sum_le_sum_of_subset_of_nonneg h (fun d hd hs => by unfold rho; positivity) lemma kernelSum_le_unweighted (L : ℕ) (hL : 0 < L) (s : Finset (ℤ × ℤ)) : kernelSum L s ≤ (∑ d ∈ s, (radius d : ℝ)⁻¹) / L := by have hL' : (0 : ℝ) < L := by exact_mod_cast hL unfold kernelSum rho calc (∑ d ∈ s, (multiplicity L d : ℝ) / ((radius d : ℝ) / L)) / (L : ℝ)^4 ≤ (∑ d ∈ s, (L : ℝ)^2 / ((radius d : ℝ) / L)) / (L : ℝ)^4 := by gcongr with d hd exact_mod_cast multiplicity_le L d _ = (∑ d ∈ s, (radius d : ℝ)⁻¹) / L := by simp only [div_eq_mul_inv, mul_inv_rev, inv_inv] rw [← mul_sum, ← mul_sum] field_simp [hL'.ne'] <;> ring lemma sum_shell_inverse (k : ℕ) : ∑ d ∈ shell k, (radius d : ℝ)⁻¹ = if k = 0 then 0 else 8 := by classical calc (∑ d ∈ shell k, (radius d : ℝ)⁻¹) = ∑ _d ∈ shell k, (k : ℝ)⁻¹ := by apply sum_congr rfl intro d hd rw [(mem_shell d k).mp hd |>.1] _ = _ := by rw [sum_const, nsmul_eq_mul, shell_card] by_cases hk : k = 0 · simp [hk] · simp [hk, Nat.cast_mul, mul_assoc, ne_of_gt (Nat.cast_pos.mpr (Nat.pos_of_ne_zero hk) : (0 : ℝ) < k)] lemma sum_square_inverse (m : ℕ) : ∑ d ∈ (square m).erase 0, (radius d : ℝ)⁻¹ = 8 * m := by classical have hmap : Set.MapsTo radius ((square m).erase 0 : Finset (ℤ × ℤ)) (Icc 1 m) := by intro d hd change d ∈ (square m).erase 0 at hd change radius d ∈ Icc 1 m rw [mem_erase, mem_square] at hd rw [mem_Icc] exact ⟨(radius_pos_iff d).mpr hd.1, hd.2⟩ rw [← sum_fiberwise_of_maps_to hmap] calc (∑ k ∈ Icc 1 m, ∑ d ∈ ((square m).erase 0).filter (fun d => radius d = k), (radius d : ℝ)⁻¹) = ∑ k ∈ Icc 1 m, (8 : ℝ) := by apply sum_congr rfl intro k hk have hkm := mem_Icc.mp hk have hf : ((square m).erase 0).filter (fun d => radius d = k) = shell k := by ext d simp only [mem_filter, mem_erase, mem_square, mem_shell] rw [← radius_pos_iff] omega rw [hf, sum_shell_inverse, if_neg (by omega)] _ = _ := by simp; ring /-- The small-square singular mass is at most `8 r`, uniformly in the grid scale. -/ lemma small_square_bound (L : ℕ) (hL : 0 < L) (r : ℝ) (hr : 0 ≤ r) : kernelSum L ((square ⌊r * L⌋₊).erase 0) ≤ 8 * r := by have hL' : (0 : ℝ) < L := by exact_mod_cast hL calc kernelSum L ((square ⌊r * L⌋₊).erase 0) ≤ (8 * (⌊r * L⌋₊ : ℝ)) / L := by simpa only [sum_square_inverse] using kernelSum_le_unweighted L hL ((square ⌊r * L⌋₊).erase 0) _ ≤ 8 * r := by apply (div_le_iff₀ hL').mpr have hf := Nat.floor_le (mul_nonneg hr hL'.le) nlinarith lemma rho_le_iff_mem_square (L : ℕ) (hL : 0 < L) (r : ℝ) (hr : 0 ≤ r) (d : ℤ × ℤ) : rho L d ≤ r ↔ d ∈ square ⌊r * L⌋₊ := by have hL' : (0 : ℝ) < L := by exact_mod_cast hL rw [rho, div_le_iff₀ hL', mem_square, Nat.le_floor_iff (mul_nonneg hr hL'.le)] def inStrip (m : ℕ) (d : ℤ × ℤ) : Prop := d.1.natAbs ≤ m ∨ d.2.natAbs ≤ m def strips (N m : ℕ) : Finset (ℤ × ℤ) := ((square N).erase 0).filter (inStrip m) lemma mem_strips (N m : ℕ) (d : ℤ × ℤ) : d ∈ strips N m ↔ d ≠ 0 ∧ radius d ≤ N ∧ inStrip m d := by simp only [strips, mem_filter, mem_erase, mem_square] tauto lemma abs_le_interval (z : ℤ) (m : ℕ) : z.natAbs ≤ m ↔ z ∈ Icc (-(m : ℤ)) m := by have hz := Int.natCast_natAbs z rw [abs_eq_max_neg] at hz simp only [mem_Icc] omega lemma natAbs_eq_endpoints (z : ℤ) (k : ℕ) : z.natAbs = k ↔ z = -(k : ℤ) ∨ z = k := by have hz := Int.natCast_natAbs z rw [abs_eq_max_neg] at hz omega /-- Outside the small square, each of the two strips has at most `4 m + 2` points in a shell; their union has at most `8 m + 4`. -/ lemma strip_shell_card (m k : ℕ) : ((shell k).filter (inStrip m)).card ≤ 8 * min k m + 4 := by classical by_cases hkm : k ≤ m · rw [min_eq_left hkm] exact (card_filter_le _ _).trans (by rw [shell_card]; omega) · have hmk : m < k := by omega rw [min_eq_right (by omega)] let v : Finset (ℤ × ℤ) := (Icc (-(m : ℤ)) m) ×ˢ {-(k : ℤ), (k : ℤ)} let h : Finset (ℤ × ℤ) := ({-(k : ℤ), (k : ℤ)} : Finset ℤ) ×ˢ (Icc (-(m : ℤ)) m) have hsub : (shell k).filter (inStrip m) ⊆ v ∪ h := by intro d hd obtain ⟨hd, hs⟩ := mem_filter.mp hd have hk := ((mem_shell d k).mp hd).1 dsimp [radius] at hk rcases hs with hx | hy · have hyk : d.2.natAbs = k := by omega apply mem_union.mpr left apply mem_product.mpr refine ⟨(abs_le_interval _ _).mp hx, ?_⟩ simpa only [mem_insert, mem_singleton] using (natAbs_eq_endpoints _ _).mp hyk · have hxk : d.1.natAbs = k := by omega apply mem_union.mpr right apply mem_product.mpr refine ⟨?_, (abs_le_interval _ _).mp hy⟩ simpa only [mem_insert, mem_singleton] using (natAbs_eq_endpoints _ _).mp hxk have hint : (Icc (-(m : ℤ)) m).card = 2 * m + 1 := by rw [Int.card_Icc] omega have hp : ({-(k : ℤ), (k : ℤ)} : Finset ℤ).card ≤ 2 := card_le_two calc ((shell k).filter (inStrip m)).card ≤ (v ∪ h).card := card_le_card hsub _ ≤ v.card + h.card := card_union_le _ _ _ ≤ (2 * m + 1) * 2 + 2 * (2 * m + 1) := by dsimp [v, h] rw [card_product, card_product, hint] exact Nat.add_le_add (Nat.mul_le_mul_left _ hp) (Nat.mul_le_mul_right _ hp) _ = 8 * m + 4 := by ring def harmonicR (N : ℕ) : ℝ := ∑ k ∈ Icc 1 N, (k : ℝ)⁻¹ lemma harmonicR_eq (N : ℕ) : harmonicR N = (harmonic N : ℝ) := by simp only [harmonicR, harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast] lemma harmonicR_upper (N : ℕ) : harmonicR N ≤ 1 + Real.log N := by rw [harmonicR_eq] exact harmonic_le_one_add_log N lemma harmonicR_lower (N : ℕ) : Real.log (N + 1 : ℕ) ≤ harmonicR N := by rw [harmonicR_eq] exact log_add_one_le_harmonic N lemma sum_min_div (N m : ℕ) (hm : m ≤ N) : (∑ k ∈ Icc 1 N, ((min k m : ℕ) : ℝ) / k) = m + (m : ℝ) * (harmonicR N - harmonicR m) := by classical have hs : Icc 1 m ⊆ Icc 1 N := by intro k hk simp only [mem_Icc] at hk ⊢ omega rw [← sum_sdiff hs] have hsmall : (∑ k ∈ Icc 1 m, ((min k m : ℕ) : ℝ) / k) = m := by calc (∑ k ∈ Icc 1 m, ((min k m : ℕ) : ℝ) / k) = ∑ _k ∈ Icc 1 m, (1 : ℝ) := by apply sum_congr rfl intro k hk have hk' := mem_Icc.mp hk rw [min_eq_left hk'.2, div_self (by exact_mod_cast (show k ≠ 0 by omega))] _ = _ := by simp have hlarge : (∑ k ∈ Icc 1 N \ Icc 1 m, ((min k m : ℕ) : ℝ) / k) = (m : ℝ) * (harmonicR N - harmonicR m) := by calc (∑ k ∈ Icc 1 N \ Icc 1 m, ((min k m : ℕ) : ℝ) / k) = ∑ k ∈ Icc 1 N \ Icc 1 m, (m : ℝ) * (k : ℝ)⁻¹ := by apply sum_congr rfl intro k hk simp only [mem_sdiff, mem_Icc] at hk rw [min_eq_right (by omega), div_eq_mul_inv] _ = (m : ℝ) * (harmonicR N - harmonicR m) := by rw [← mul_sum, sum_sdiff_eq_sub hs] rfl rw [hsmall, hlarge] ring lemma strip_inverse_bound (N m : ℕ) (hm : m ≤ N) : (∑ d ∈ strips N m, (radius d : ℝ)⁻¹) ≤ 8 * (m + (m : ℝ) * (harmonicR N - harmonicR m)) + 4 * harmonicR N := by classical have hmap : Set.MapsTo radius (strips N m : Finset (ℤ × ℤ)) (Icc 1 N) := by intro d hd obtain ⟨hd0, hdN, hdm⟩ := (mem_strips N m d).mp hd exact mem_Icc.mpr ⟨(radius_pos_iff d).mpr hd0, hdN⟩ rw [← sum_fiberwise_of_maps_to hmap] calc (∑ k ∈ Icc 1 N, ∑ d ∈ (strips N m).filter (fun d => radius d = k), (radius d : ℝ)⁻¹) ≤ ∑ k ∈ Icc 1 N, (8 * ((min k m : ℕ) : ℝ) + 4) / k := by apply sum_le_sum intro k hk have hk' := mem_Icc.mp hk have hf : (strips N m).filter (fun d => radius d = k) = (shell k).filter (inStrip m) := by ext d simp only [mem_filter, mem_strips, mem_shell] constructor · rintro ⟨⟨hd0, hdN, hdm⟩, hdk⟩ exact ⟨⟨hdk, hd0⟩, hdm⟩ · rintro ⟨⟨hdk, hd0⟩, hdm⟩ exact ⟨⟨hd0, hdk.trans_le hk'.2, hdm⟩, hdk⟩ rw [hf] calc (∑ d ∈ (shell k).filter (inStrip m), (radius d : ℝ)⁻¹) = (((shell k).filter (inStrip m)).card : ℝ) / k := by calc (∑ d ∈ (shell k).filter (inStrip m), (radius d : ℝ)⁻¹) = ∑ _d ∈ (shell k).filter (inStrip m), (k : ℝ)⁻¹ := by apply sum_congr rfl intro d hd rw [((mem_shell d k).mp (mem_filter.mp hd).1).1] _ = _ := by simp [div_eq_mul_inv] _ ≤ (8 * ((min k m : ℕ) : ℝ) + 4) / k := by apply div_le_div_of_nonneg_right _ (by positivity) exact_mod_cast strip_shell_card m k _ = 8 * (m + (m : ℝ) * (harmonicR N - harmonicR m)) + 4 * harmonicR N := by calc (∑ k ∈ Icc 1 N, (8 * ((min k m : ℕ) : ℝ) + 4) / k) = 8 * (∑ k ∈ Icc 1 N, ((min k m : ℕ) : ℝ) / k) + 4 * harmonicR N := by unfold harmonicR rw [mul_sum, mul_sum, ← sum_add_distrib] apply sum_congr rfl intro k hk simp only [div_eq_mul_inv] ring _ = _ := by rw [sum_min_div N m hm] /-- The axes, including all four directions and excluding the origin. -/ lemma axes_bound (L : ℕ) (hL : 0 < L) : kernelSum L (strips L 0) ≤ 4 * (1 + Real.log L) / L := by have hL' : (0 : ℝ) < L := by exact_mod_cast hL calc kernelSum L (strips L 0) ≤ (∑ d ∈ strips L 0, (radius d : ℝ)⁻¹) / L := kernelSum_le_unweighted L hL _ _ ≤ (4 * harmonicR L) / L := by apply div_le_div_of_nonneg_right _ hL'.le simpa using strip_inverse_bound L 0 (Nat.zero_le _) _ ≤ 4 * (1 + Real.log L) / L := by gcongr exact harmonicR_upper L lemma inStrip_zero_iff (d : ℤ × ℤ) : inStrip 0 d ↔ d.1 = 0 ∨ d.2 = 0 := by simp [inStrip] lemma harmonic_tail_log_bound (L m : ℕ) (hL : 0 < L) (r : ℝ) (hr : 0 < r) (hm : r * L < m + 1) : harmonicR L - harmonicR m ≤ 1 + |Real.log r| := by have hL' : (0 : ℝ) < L := by exact_mod_cast hL have hp : 0 < r * (L : ℝ) := mul_pos hr hL' have hlog : Real.log (r * L) ≤ Real.log ((m : ℝ) + 1) := Real.log_le_log hp hm.le rw [Real.log_mul hr.ne' hL'.ne'] at hlog have hup := harmonicR_upper L have hlo := harmonicR_lower m push_cast at hlo have habs := neg_le_abs (Real.log r) linarith /-- Uniform finite strip domination. No limiting hypothesis or assumed histogram enters the bound. The constant `20` is independent of both `L` and `r`. -/ lemma strips_bound (L : ℕ) (hL : 0 < L) (r : ℝ) (hr : 0 < r) (hr1 : r ≤ 1) : kernelSum L (strips L ⌊r * L⌋₊) ≤ 20 * (r * (1 + |Real.log r|) + (1 + Real.log L) / L) := by have hL' : (0 : ℝ) < L := by exact_mod_cast hL let m := ⌊r * L⌋₊ have hm0 : (m : ℝ) ≤ r * L := Nat.floor_le (mul_nonneg hr.le hL'.le) have hm1 : r * L < (m : ℝ) + 1 := Nat.lt_floor_add_one (r * L) have hmL : m ≤ L := by have h : (m : ℝ) ≤ L := hm0.trans (by nlinarith) exact_mod_cast h have ht := harmonic_tail_log_bound L m hL r hr hm1 have hlogL : 0 ≤ Real.log (L : ℝ) := Real.log_nonneg (by exact_mod_cast hL) have hH := harmonicR_upper L have habs := abs_nonneg (Real.log r) have hmcast : (0 : ℝ) ≤ m := by positivity have hcoeff : (m : ℝ) * (harmonicR L - harmonicR m) ≤ (m : ℝ) * (1 + |Real.log r|) := mul_le_mul_of_nonneg_left ht hmcast have hscale : (m : ℝ) * (1 + |Real.log r|) ≤ (r * L) * (1 + |Real.log r|) := mul_le_mul_of_nonneg_right hm0 (by positivity) calc kernelSum L (strips L m) ≤ (∑ d ∈ strips L m, (radius d : ℝ)⁻¹) / L := kernelSum_le_unweighted L hL _ _ ≤ (8 * (m + (m : ℝ) * (harmonicR L - harmonicR m)) + 4 * harmonicR L) / L := div_le_div_of_nonneg_right (strip_inverse_bound L m hmL) hL'.le _ ≤ 20 * (r * (1 + |Real.log r|) + (1 + Real.log L) / L) := by apply (div_le_iff₀ hL').mpr have heq : (20 * (r * (1 + |Real.log r|) + (1 + Real.log L) / L)) * L = 20 * (r * L * (1 + |Real.log r|) + (1 + Real.log L)) := by field_simp [hL'.ne'] <;> ring rw [heq] nlinarith [mul_nonneg hr.le habs, mul_nonneg (mul_nonneg hr.le habs) hL'.le] lemma displacements_subset_square (L : ℕ) : displacements L ⊆ square L := by intro d hd obtain ⟨p, hp, rfl⟩ := mem_image.mp hd rw [mem_square] unfold radius displacement exact max_le (Int.natAbs_coe_sub_coe_le_of_le p.2.1.isLt.le p.1.1.isLt.le) (Int.natAbs_coe_sub_coe_le_of_le p.2.2.isLt.le p.1.2.isLt.le) /-- The radius cutoff version over the actual displacement support. -/ lemma actual_small_square_bound (L : ℕ) (hL : 0 < L) (r : ℝ) (hr : 0 ≤ r) : kernelSum L ((displacements L).filter (fun d => d ≠ 0 ∧ rho L d ≤ r)) ≤ 8 * r := by apply (kernelSum_mono L ?_).trans (small_square_bound L hL r hr) intro d hd obtain ⟨hd, hd0, hdr⟩ := mem_filter.mp hd exact mem_erase.mpr ⟨hd0, (rho_le_iff_mem_square L hL r hr d).mp hdr⟩ lemma coordinate_cutoff_iff (L : ℕ) (hL : 0 < L) (r : ℝ) (hr : 0 ≤ r) (z : ℤ) : (z.natAbs : ℝ) / L ≤ r ↔ z.natAbs ≤ ⌊r * L⌋₊ := by have hL' : (0 : ℝ) < L := by exact_mod_cast hL rw [div_le_iff₀ hL', Nat.le_floor_iff (mul_nonneg hr hL'.le)] /-- The two coordinate strips in the requested normalized coordinates. -/ lemma actual_strips_bound (L : ℕ) (hL : 0 < L) (r : ℝ) (hr : 0 < r) (hr1 : r ≤ 1) : kernelSum L ((displacements L).filter (fun d => d ≠ 0 ∧ ((d.1.natAbs : ℝ) / L ≤ r ∨ (d.2.natAbs : ℝ) / L ≤ r))) ≤ 20 * (r * (1 + |Real.log r|) + (1 + Real.log L) / L) := by apply (kernelSum_mono L ?_).trans (strips_bound L hL r hr hr1) intro d hd obtain ⟨hd, hd0, hdr⟩ := mem_filter.mp hd apply (mem_strips L ⌊r * L⌋₊ d).mpr refine ⟨hd0, (mem_square d L).mp (displacements_subset_square L hd), ?_⟩ unfold inStrip simpa only [coordinate_cutoff_iff L hL r hr.le] using hdr lemma actual_axes_bound (L : ℕ) (hL : 0 < L) : kernelSum L ((displacements L).filter (fun d => d ≠ 0 ∧ (d.1 = 0 ∨ d.2 = 0))) ≤ 4 * (1 + Real.log L) / L := by apply (kernelSum_mono L ?_).trans (axes_bound L hL) intro d hd obtain ⟨hd, hd0, haxes⟩ := mem_filter.mp hd exact (mem_strips L 0 d).mpr ⟨hd0, (mem_square d L).mp (displacements_subset_square L hd), (inStrip_zero_iff d).mpr haxes⟩ end GridPairs end DistanceCounts end end BodyFile006 -- Source: DistanceCounts/CoarseGrid.lean section BodyFile007 noncomputable section namespace DistanceCounts.CoarseGrid open OffsetSeparation /-- The two prime indices present in a coarse block. -/ def blockAxes {t : ℕ} (b : Fin t × Fin t) : Finset (Fin t ⊕ Fin t) := {.inl b.1, .inr b.2} /-- Shared row and column denominators cancel before a modulus is formed. -/ def pairSupport {t : ℕ} (b c : Fin t × Fin t) : Finset (Fin t ⊕ Fin t) := (blockAxes b \ blockAxes c) ∪ (blockAxes c \ blockAxes b) /-- Orientation is pin minus target, matching `sqDist` coordinate differences. -/ def pairSign {t : ℕ} (b c : Fin t × Fin t) (i : Fin t ⊕ Fin t) : ℤ := (if i ∈ blockAxes b then 1 else 0) - (if i ∈ blockAxes c then 1 else 0) theorem blockAxes_card {t : ℕ} (b : Fin t × Fin t) : (blockAxes b).card = 2 := by simp [blockAxes] theorem pairSupport_card_le_four {t : ℕ} (b c : Fin t × Fin t) : (pairSupport b c).card ≤ 4 := by have h₁ : (blockAxes b \ blockAxes c).card ≤ 2 := by calc _ ≤ (blockAxes b).card := Finset.card_le_card Finset.sdiff_subset _ = 2 := blockAxes_card b have h₂ : (blockAxes c \ blockAxes b).card ≤ 2 := by calc _ ≤ (blockAxes c).card := Finset.card_le_card Finset.sdiff_subset _ = 2 := blockAxes_card c exact (Finset.card_union_le _ _).trans (by omega) abbrev PinIndex (t L : ℕ) := (Fin t × Fin t) × GridPairs.Grid L def rationalPin {t : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (a b : Fin t) (x y : ℤ) : ℚ × ℚ := rationalOffset (z (.inl a)) (p (.inl a)) + rationalOffset (z (.inr b)) (p (.inr b)) + integerVector (x, y) def embed (q : ℚ × ℚ) : Point := planePoint q.1 q.2 def pin {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (i : PinIndex t L) : Point := embed (rationalPin p z i.1.1 i.1.2 i.2.1 i.2.2) def pins {t : ℕ} (L : ℕ) (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) : Finset Point := by classical exact Finset.univ.image (pin (L := L) p z) theorem pin_mem {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (i : PinIndex t L) : pin p z i ∈ pins L p z := by classical exact Finset.mem_image.mpr ⟨i, Finset.mem_univ _, rfl⟩ def direction : Point := planePoint 1 (Real.sqrt 2) def project (q : ℚ × ℚ) : ℝ := (q.1 : ℝ) + Real.sqrt 2 * (q.2 : ℝ) theorem direction_ne_zero : direction ≠ 0 := by intro h have := congrArg (fun v : Point => v 0) h norm_num [direction, planePoint] at this theorem project_injective : Function.Injective project := rational_sqrt_two_projection_injective theorem project_add (q r : ℚ × ℚ) : project (q + r) = project q + project r := by simp [project, mul_add] ring theorem projection_embed (q : ℚ × ℚ) : lineProjection direction (embed q) = project q := by simp [lineProjection, direction, embed, planePoint, project] theorem twice_pin {t : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (a b : Fin t) (x y : ℤ) : project (blockPoint p z (.inl a) (x, y) + blockPoint p z (.inr b) (0, 0)) = 2 * project (rationalPin p z a b x y) := by simp [project, blockPoint, rationalPin, integerVector] ring theorem pin_injective {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) : Function.Injective (pin (L := L) p z) := by intro i j he have hq : rationalPin p z i.1.1 i.1.2 i.2.1 i.2.2 = rationalPin p z j.1.1 j.1.2 j.2.1 j.2.2 := by apply Prod.ext · have h := congrArg (fun v : Point => v 0) he dsimp [pin, embed, planePoint] at h exact_mod_cast h · have h := congrArg (fun v : Point => v 1) he dsimp [pin, embed, planePoint] at h exact_mod_cast h have hs := offset_pair_separation p z hp hd hz (fun k => inert_gt_two _ (hp k) (hinert k)) (.inl i.1.1) (.inr i.1.2) (.inl j.1.1) (.inr j.1.2) (i.2.1, i.2.2) (j.2.1, j.2.2) hq have hab : i.1.1 = j.1.1 ∧ i.1.2 = j.1.2 := by simpa using hs have hxy : i.2 = j.2 := by apply Prod.ext <;> apply Fin.ext · have h := congrArg Prod.fst hq simp only [rationalPin, Prod.fst_add, integerVector, hab.1, hab.2] at h exact_mod_cast (add_left_cancel h) · have h := congrArg Prod.snd hq simp only [rationalPin, Prod.snd_add, integerVector, hab.1, hab.2] at h exact_mod_cast (add_left_cancel h) exact Prod.ext (Prod.ext hab.1 hab.2) hxy theorem pins_card {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) : (pins L p z).card = t ^ 2 * L ^ 2 := by classical rw [pins, Finset.card_image_of_injective _ (pin_injective p z hp hd hz hinert)] simp [PinIndex, GridPairs.Grid, pow_two, mul_assoc] end DistanceCounts.CoarseGrid end end BodyFile007 -- Source: DistanceCounts/GaussianResidues.lean section BodyFile008 noncomputable section namespace DistanceCounts.GaussianResidues abbrev Residue (q : ℕ) := GaussianInt ⧸ Ideal.span ({(q : GaussianInt)} : Set GaussianInt) /-- Integer coordinates characterize equality in the actual Gaussian quotient. -/ theorem residue_eq_iff (q : ℕ) (z w : GaussianInt) : GaussianNorm.residue q z = GaussianNorm.residue q w ↔ (z.re : ZMod q) = (w.re : ZMod q) ∧ (z.im : ZMod q) = (w.im : ZMod q) := by rw [GaussianNorm.residue, GaussianNorm.residue, Ideal.Quotient.eq, Ideal.mem_span_singleton] have h := Zsqrtd.intCast_dvd (q : ℤ) (z - w) simp only [Int.cast_natCast, Zsqrtd.re_sub, Zsqrtd.im_sub] at h rw [h] constructor · rintro ⟨hr, hi⟩ constructor · apply sub_eq_zero.mp simpa using (ZMod.intCast_zmod_eq_zero_iff_dvd (z.re - w.re) q).2 hr · apply sub_eq_zero.mp simpa using (ZMod.intCast_zmod_eq_zero_iff_dvd (z.im - w.im) q).2 hi · rintro ⟨hr, hi⟩ constructor · apply (ZMod.intCast_zmod_eq_zero_iff_dvd _ q).1 simpa [hr] · apply (ZMod.intCast_zmod_eq_zero_iff_dvd _ q).1 simpa [hi] /-- This is a map of sets, not a map to the coordinatewise product ring. -/ def coordinates (q : ℕ) (a : Residue q) : ZMod q × ZMod q := ((Quotient.out a).re, (Quotient.out a).im) theorem coordinates_residue (q : ℕ) (z : GaussianInt) : coordinates q (GaussianNorm.residue q z) = ((z.re : ZMod q), (z.im : ZMod q)) := by apply Prod.ext · exact ((residue_eq_iff q _ _).1 (Ideal.Quotient.mk_out _)).1 · exact ((residue_eq_iff q _ _).1 (Ideal.Quotient.mk_out _)).2 theorem coordinates_injective (q : ℕ) : Function.Injective (coordinates q) := by intro a b h obtain ⟨z, rfl⟩ := Ideal.Quotient.mk_surjective a obtain ⟨w, rfl⟩ := Ideal.Quotient.mk_surjective b apply (residue_eq_iff q z w).2 change coordinates q (GaussianNorm.residue q z) = coordinates q (GaussianNorm.residue q w) at h rw [coordinates_residue, coordinates_residue] at h exact Prod.mk.inj h /-- The genuine underlying-set equivalence; multiplication is described below. -/ def coordinateEquiv (q : ℕ) : Residue q ≃ ZMod q × ZMod q where toFun := coordinates q invFun v := GaussianNorm.residue q ⟨ZMod.cast v.1, ZMod.cast v.2⟩ left_inv a := by apply coordinates_injective q change coordinates q (GaussianNorm.residue q ⟨ZMod.cast (coordinates q a).1, ZMod.cast (coordinates q a).2⟩) = coordinates q a rw [coordinates_residue] exact Prod.ext (ZMod.intCast_zmod_cast _) (ZMod.intCast_zmod_cast _) right_inv v := by change coordinates q (GaussianNorm.residue q ⟨ZMod.cast v.1, ZMod.cast v.2⟩) = v rw [coordinates_residue] exact Prod.ext (ZMod.intCast_zmod_cast _) (ZMod.intCast_zmod_cast _) theorem finite_residue (q : ℕ) (hq : 0 < q) : Finite (Residue q) := by letI : NeZero q := ⟨hq.ne'⟩ exact Finite.of_injective (coordinates q) (coordinates_injective q) theorem card_residue (q : ℕ) : Nat.card (Residue q) = q ^ 2 := by rw [Nat.card_congr (coordinateEquiv q)] simp [Nat.card_prod, pow_two] theorem coordinates_zero (q : ℕ) : coordinates q 0 = (0, 0) := by simpa [GaussianNorm.residue] using coordinates_residue q 0 theorem coordinates_one (q : ℕ) : coordinates q 1 = (1, 0) := by simpa [GaussianNorm.residue] using coordinates_residue q 1 theorem coordinates_mul (q : ℕ) (a b : Residue q) : coordinates q (a * b) = ((coordinates q a).1 * (coordinates q b).1 - (coordinates q a).2 * (coordinates q b).2, (coordinates q a).1 * (coordinates q b).2 + (coordinates q a).2 * (coordinates q b).1) := by obtain ⟨z, rfl⟩ := Ideal.Quotient.mk_surjective a obtain ⟨w, rfl⟩ := Ideal.Quotient.mk_surjective b change coordinates q (GaussianNorm.residue q (z * w)) = ((coordinates q (GaussianNorm.residue q z)).1 * (coordinates q (GaussianNorm.residue q w)).1 - (coordinates q (GaussianNorm.residue q z)).2 * (coordinates q (GaussianNorm.residue q w)).2, (coordinates q (GaussianNorm.residue q z)).1 * (coordinates q (GaussianNorm.residue q w)).2 + (coordinates q (GaussianNorm.residue q z)).2 * (coordinates q (GaussianNorm.residue q w)).1) simp [coordinates_residue, Zsqrtd.re_mul, Zsqrtd.im_mul, sub_eq_add_neg] /-- Conjugation induced by Gaussian conjugation on the quotient. -/ def conjugate (q : ℕ) (a : Residue q) : Residue q := (coordinateEquiv q).symm ((coordinates q a).1, -(coordinates q a).2) theorem coordinates_conjugate (q : ℕ) (a : Residue q) : coordinates q (conjugate q a) = ((coordinates q a).1, -(coordinates q a).2) := (coordinateEquiv q).apply_symm_apply _ theorem conjugate_residue (q : ℕ) (z : GaussianInt) : conjugate q (GaussianNorm.residue q z) = GaussianNorm.residue q (star z) := by apply coordinates_injective q simp [coordinates_conjugate, coordinates_residue] /-- Reduction of the actual Gaussian norm. -/ def norm (q : ℕ) (a : Residue q) : ZMod q := (coordinates q a).1 ^ 2 + (coordinates q a).2 ^ 2 theorem norm_residue (q : ℕ) (z : GaussianInt) : norm q (GaussianNorm.residue q z) = (z.norm : ZMod q) := by simp [norm, coordinates_residue, Zsqrtd.norm] ring theorem coordinates_mul_conjugate (q : ℕ) (a : Residue q) : coordinates q (a * conjugate q a) = (norm q a, 0) := by rw [coordinates_mul, coordinates_conjugate] simp only [norm] apply Prod.ext <;> dsimp <;> ring /-- A counting lemma whose finiteness hypotheses are local to its use. -/ private theorem card_le_fibers {A B : Type*} [Finite A] [Fintype B] (f : A → B) (k : ℕ) (h : ∀ b, Nat.card {a // f a = b} ≤ k) : Nat.card A ≤ Fintype.card B * k := by rw [← Nat.card_congr (Equiv.sigmaFiberEquiv f), Nat.card_sigma] calc ∑ b, Nat.card {a // f a = b} ≤ ∑ _ : B, k := Finset.sum_le_sum fun b _ => h b _ = Fintype.card B * k := by simp /-- Over a domain, a square has at most two roots, including characteristic two. -/ private theorem card_square_fiber {K : Type*} [CommRing K] [IsDomain K] [Finite K] (t : K) : Nat.card {x : K // x ^ 2 = t} ≤ 2 := by classical by_cases ht : ∃ x : K, x ^ 2 = t · obtain ⟨r, hr⟩ := ht let f : {x : K // x ^ 2 = t} → Bool := fun x => decide (x.1 = r) have hx (x : {x : K // x ^ 2 = t}) : x.1 = r ∨ x.1 = -r := by have hm : (x.1 - r) * (x.1 + r) = 0 := by calc _ = x.1 ^ 2 - r ^ 2 := by ring _ = 0 := by rw [x.2, hr, sub_self] rcases mul_eq_zero.mp hm with h | h · exact Or.inl (sub_eq_zero.mp h) · right linear_combination h have hf : Function.Injective f := by intro x y h apply Subtype.ext have hd : (x.1 = r) ↔ (y.1 = r) := by simpa [f] using h rcases hx x with hxr | hxr · exact hxr.trans (hd.mp hxr).symm · rcases hx y with hy | hy · exact (hd.mpr hy).trans hy.symm · exact hxr.trans hy.symm simpa using Nat.card_le_card_of_injective f hf · haveI : IsEmpty {x : K // x ^ 2 = t} := ⟨fun x => ht ⟨x.1, x.2⟩⟩ simp /-- Every norm fiber in the real prime quotient has at most `2p` elements. -/ theorem card_norm_fiber_prime (p : ℕ) (hp : p.Prime) (t : ZMod p) : Nat.card {a : Residue p // norm p a = t} ≤ 2 * p := by letI : Fact p.Prime := ⟨hp⟩ letI : Finite (Residue p) := finite_residue p hp.pos let f : {a : Residue p // norm p a = t} → ZMod p := fun a => (coordinates p a.1).2 have hb (y : ZMod p) : Nat.card {a // f a = y} ≤ 2 := by let g : {a // f a = y} → {x : ZMod p // x ^ 2 = t - y ^ 2} := fun a => ⟨(coordinates p a.1.1).1, by have ha := a.1.2 change (coordinates p a.1.1).1 ^ 2 + (coordinates p a.1.1).2 ^ 2 = t at ha have hy : (coordinates p a.1.1).2 = y := a.2 rw [hy] at ha exact eq_sub_of_add_eq ha⟩ have hg : Function.Injective g := by intro a b h apply Subtype.ext apply Subtype.ext apply coordinates_injective p exact Prod.ext (congrArg Subtype.val h) (a.2.trans b.2.symm) exact (Nat.card_le_card_of_injective g hg).trans (card_square_fiber _) simpa [ZMod.card, Nat.mul_comm] using card_le_fibers f 2 hb /-- A nonzero homogeneous linear equation cuts out at most one point above each value of one coordinate. -/ theorem card_linear_fiber_prime (p : ℕ) (hp : p.Prime) (u v : ZMod p) (huv : u ≠ 0 ∨ v ≠ 0) : Nat.card {a : Residue p // u * (coordinates p a).1 + v * (coordinates p a).2 = 0} ≤ p := by letI : Fact p.Prime := ⟨hp⟩ rcases huv with hu | hv · let f : {a : Residue p // u * (coordinates p a).1 + v * (coordinates p a).2 = 0} → ZMod p := fun a => (coordinates p a.1).2 have hf : Function.Injective f := by intro a b h apply Subtype.ext apply coordinates_injective p apply Prod.ext · apply mul_left_cancel₀ hu have ha := a.2 have hb := b.2 change (coordinates p a.1).2 = (coordinates p b.1).2 at h rw [h] at ha linear_combination ha - hb · exact h simpa using Nat.card_le_card_of_injective f hf · let f : {a : Residue p // u * (coordinates p a).1 + v * (coordinates p a).2 = 0} → ZMod p := fun a => (coordinates p a.1).1 have hf : Function.Injective f := by intro a b h apply Subtype.ext apply coordinates_injective p apply Prod.ext · exact h · apply mul_left_cancel₀ hv have ha := a.2 have hb := b.2 change (coordinates p a.1).1 = (coordinates p b.1).1 at h rw [h] at ha linear_combination ha - hb simpa using Nat.card_le_card_of_injective f hf theorem ratio_equation_coordinates (p : ℕ) (a b c : Residue p) : a * b = conjugate p a * c ↔ ((coordinates p b).1 - (coordinates p c).1) * (coordinates p a).1 - ((coordinates p b).2 + (coordinates p c).2) * (coordinates p a).2 = 0 ∧ ((coordinates p b).2 - (coordinates p c).2) * (coordinates p a).1 + ((coordinates p b).1 + (coordinates p c).1) * (coordinates p a).2 = 0 := by rw [← (coordinates_injective p).eq_iff, coordinates_mul, coordinates_mul, coordinates_conjugate, Prod.mk.injEq] constructor · rintro ⟨hr, hi⟩ constructor · linear_combination hr · linear_combination hi · rintro ⟨hr, hi⟩ constructor · linear_combination hr · linear_combination hi /-- No division by `a` is involved: the bound includes the zero solution. -/ theorem card_ratio_fiber_prime (p : ℕ) (hp : p.Prime) (hodd : p ≠ 2) (b c : Residue p) (hb : b ≠ 0) : Nat.card {a : Residue p // a * b = conjugate p a * c} ≤ p := by classical letI : Fact p.Prime := ⟨hp⟩ letI : Finite (Residue p) := finite_residue p hp.pos have htwo : (2 : ZMod p) ≠ 0 := by intro h have hd : p ∣ 2 := (ZMod.natCast_eq_zero_iff 2 p).1 h have := Nat.le_of_dvd (by decide : 0 < 2) hd have := hp.two_le omega let u := (coordinates p b).1 - (coordinates p c).1 let v := -((coordinates p b).2 + (coordinates p c).2) let s := (coordinates p b).2 - (coordinates p c).2 let t := (coordinates p b).1 + (coordinates p c).1 have hnonzero : (u ≠ 0 ∨ v ≠ 0) ∨ (s ≠ 0 ∨ t ≠ 0) := by by_contra h have hh : u = 0 ∧ v = 0 ∧ s = 0 ∧ t = 0 := by tauto rcases hh with ⟨hu, hv, hs, ht⟩ apply hb apply coordinates_injective p rw [coordinates_zero] apply Prod.ext · have hz : (2 : ZMod p) * (coordinates p b).1 = 0 := by dsimp [u] at hu dsimp [t] at ht linear_combination hu + ht exact (mul_eq_zero.mp hz).resolve_left htwo · have hz : (2 : ZMod p) * (coordinates p b).2 = 0 := by dsimp [v] at hv dsimp [s] at hs linear_combination hs - hv exact (mul_eq_zero.mp hz).resolve_left htwo rcases hnonzero with h | h · let f : {a : Residue p // a * b = conjugate p a * c} → {a : Residue p // u * (coordinates p a).1 + v * (coordinates p a).2 = 0} := fun a => ⟨a.1, by have ha := ((ratio_equation_coordinates p a.1 b c).1 a.2).1 dsimp [u, v] linear_combination ha⟩ have hf : Function.Injective f := by intro a a' haa apply Subtype.ext exact congrArg (fun x : {a : Residue p // u * (coordinates p a).1 + v * (coordinates p a).2 = 0} => x.1) haa exact (Nat.card_le_card_of_injective f hf).trans (card_linear_fiber_prime p hp u v h) · let f : {a : Residue p // a * b = conjugate p a * c} → {a : Residue p // s * (coordinates p a).1 + t * (coordinates p a).2 = 0} := fun a => ⟨a.1, ((ratio_equation_coordinates p a.1 b c).1 a.2).2⟩ have hf : Function.Injective f := by intro a a' haa apply Subtype.ext exact congrArg (fun x : {a : Residue p // s * (coordinates p a).1 + t * (coordinates p a).2 = 0} => x.1) haa exact (Nat.card_le_card_of_injective f hf).trans (card_linear_fiber_prime p hp s t h) theorem norm_ne_zero_iff_inert (p : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) (a : Residue p) : norm p a ≠ 0 ↔ a ≠ 0 := by obtain ⟨z, rfl⟩ := Ideal.Quotient.mk_surjective a change norm p (GaussianNorm.residue p z) ≠ 0 ↔ GaussianNorm.residue p z ≠ 0 rw [norm_residue, GaussianNorm.residue_ne_zero_iff, ne_eq, ZMod.intCast_zmod_eq_zero_iff_dvd, GaussianNorm.inert_dvd_norm_iff p hp hp3] /-- Nonzero classes are precisely the units in an inert prime quotient. -/ theorem isUnit_iff_ne_zero_inert (p : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) (a : Residue p) : IsUnit a ↔ a ≠ 0 := by letI : Fact p.Prime := ⟨hp⟩ constructor · intro ha hz obtain ⟨w, hw⟩ := ha.exists_right_inv rw [hz, zero_mul] at hw have hc := congrArg (fun a => (coordinates p a).1) hw simpa [coordinates_zero, coordinates_one] using hc · intro ha have hn := (norm_ne_zero_iff_inert p hp hp3 a).2 ha let w := (coordinateEquiv p).symm ((coordinates p a).1 / norm p a, -(coordinates p a).2 / norm p a) apply IsUnit.of_mul_eq_one w apply coordinates_injective p rw [coordinates_mul, coordinates_one] have hw : coordinates p w = ((coordinates p a).1 / norm p a, -(coordinates p a).2 / norm p a) := (coordinateEquiv p).apply_symm_apply _ rw [hw] apply Prod.ext · dsimp field_simp [hn] simp only [norm] ring · dsimp ring theorem card_nonzero (q : ℕ) (hq : 0 < q) : Nat.card {a : Residue q // a ≠ 0} = q ^ 2 - 1 := by classical letI : Finite (Residue q) := finite_residue q hq letI : Fintype (Residue q) := Fintype.ofFinite _ rw [Nat.card_eq_fintype_card, Fintype.card_subtype_compl, Fintype.card_subtype_eq, ← Nat.card_eq_fintype_card, card_residue] theorem card_units_inert (p : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) : Nat.card {a : Residue p // IsUnit a} = p ^ 2 - 1 := by have h : {a : Residue p // IsUnit a} ≃ {a : Residue p // a ≠ 0} := Equiv.subtypeEquivRight (fun a => isUnit_iff_ne_zero_inert p hp hp3 a) rw [Nat.card_congr h, card_nonzero p hp.pos] theorem card_unit_group_inert (p : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) : Nat.card (Residue p)ˣ = p ^ 2 - 1 := by let f : (Residue p)ˣ → {a : Residue p // IsUnit a} := fun u => ⟨u, u.isUnit⟩ have hf : Function.Bijective f := by constructor · intro u v h apply Units.ext exact congrArg Subtype.val h · rintro ⟨a, u, rfl⟩ exact ⟨u, rfl⟩ rw [Nat.card_eq_of_bijective f hf, card_units_inert p hp hp3] /-- This is the bad numerator for the oblique projection, on actual classes. -/ theorem card_bad_projection_prime (p : ℕ) (hp : p.Prime) (L : ZMod p) : Nat.card {a : Residue p // L * (coordinates p a).1 + (coordinates p a).2 = 0} ≤ p := by letI : Fact p.Prime := ⟨hp⟩ simpa using card_linear_fiber_prime p hp L 1 (Or.inr one_ne_zero) /-- The canonical reduction between the genuine quotient rings. -/ def reduce {p q : ℕ} (hpq : p ∣ q) : Residue q →+* Residue p := Ideal.Quotient.lift _ (Ideal.Quotient.mk _) (by intro z hz apply Ideal.Quotient.eq_zero_iff_mem.2 apply Ideal.mem_span_singleton.2 have hpq' : (p : GaussianInt) ∣ (q : GaussianInt) := by obtain ⟨k, rfl⟩ := hpq exact ⟨(k : GaussianInt), by simp⟩ exact hpq'.trans (Ideal.mem_span_singleton.1 hz)) theorem reduce_residue {p q : ℕ} (hpq : p ∣ q) (z : GaussianInt) : reduce hpq (GaussianNorm.residue q z) = GaussianNorm.residue p z := rfl theorem coordinates_reduce {p q : ℕ} (hpq : p ∣ q) (a : Residue q) : coordinates p (reduce hpq a) = (ZMod.castHom hpq (ZMod p) (coordinates q a).1, ZMod.castHom hpq (ZMod p) (coordinates q a).2) := by obtain ⟨z, rfl⟩ := Ideal.Quotient.mk_surjective a change coordinates p (reduce hpq (GaussianNorm.residue q z)) = (ZMod.castHom hpq (ZMod p) (coordinates q (GaussianNorm.residue q z)).1, ZMod.castHom hpq (ZMod p) (coordinates q (GaussianNorm.residue q z)).2) rw [reduce_residue, coordinates_residue, coordinates_residue] simp theorem norm_reduce {p q : ℕ} (hpq : p ∣ q) (a : Residue q) : norm p (reduce hpq a) = ZMod.castHom hpq (ZMod p) (norm q a) := by obtain ⟨z, rfl⟩ := Ideal.Quotient.mk_surjective a change norm p (reduce hpq (GaussianNorm.residue q z)) = ZMod.castHom hpq (ZMod p) (norm q (GaussianNorm.residue q z)) rw [reduce_residue, norm_residue, norm_residue, map_intCast] theorem conjugate_reduce {p q : ℕ} (hpq : p ∣ q) (a : Residue q) : conjugate p (reduce hpq a) = reduce hpq (conjugate q a) := by obtain ⟨z, rfl⟩ := Ideal.Quotient.mk_surjective a change conjugate p (reduce hpq (GaussianNorm.residue q z)) = reduce hpq (conjugate q (GaussianNorm.residue q z)) rw [reduce_residue, conjugate_residue, conjugate_residue, reduce_residue] /-- The actual CRT reduction map. Only its injectivity is needed for upper bounds. -/ def crtReduction (S : Finset ℕ) : Residue (∏ p ∈ S, p) → ∀ p : S, Residue p.1 := fun a p => reduce (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2) a theorem crtReduction_injective (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) : Function.Injective (crtReduction S) := by intro a b h obtain ⟨z, rfl⟩ := Ideal.Quotient.mk_surjective a obtain ⟨w, rfl⟩ := Ideal.Quotient.mk_surjective b apply Ideal.Quotient.eq.2 apply Ideal.mem_span_singleton.2 have hd : ∀ p ∈ S, (p : GaussianInt) ∣ z - w := by intro p hp have he := congrFun h ⟨p, hp⟩ change GaussianNorm.residue p z = GaussianNorm.residue p w at he exact Ideal.mem_span_singleton.1 (Ideal.Quotient.eq.1 he) have hcop : (S : Set ℕ).Pairwise (fun p r => IsCoprime (p : GaussianInt) (r : GaussianInt)) := by intro p hp r hr hpr exact ((Nat.coprime_primes (hprime p hp) (hprime r hr)).2 hpr).cast simpa using (Finset.prod_dvd_of_coprime hcop hd) /-- CRT bounds the size of any compatible fiber by the product of its local sizes. -/ theorem card_crt_fiber_le (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (P : Residue (∏ p ∈ S, p) → Prop) (Q : ∀ p : S, Residue p.1 → Prop) (hPQ : ∀ a, P a → ∀ p : S, Q p (crtReduction S a p)) : Nat.card {a // P a} ≤ ∏ p : S, Nat.card {a // Q p a} := by letI : ∀ p : S, Finite (Residue p.1) := fun p => finite_residue p.1 (hprime p.1 p.2).pos let f : {a // P a} → ∀ p : S, {a // Q p a} := fun a p => ⟨crtReduction S a.1 p, hPQ a.1 a.2 p⟩ have hf : Function.Injective f := by intro a b h apply Subtype.ext apply crtReduction_injective S hprime funext p exact congrArg Subtype.val (congrFun h p) simpa only [Nat.card_pi] using Nat.card_le_card_of_injective f hf /-- Distinct prime factors give `2^|S| q`; inertness is not needed for this bound. -/ theorem card_norm_fiber_product (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (t : ZMod (∏ p ∈ S, p)) : Nat.card {a : Residue (∏ p ∈ S, p) // norm (∏ p ∈ S, p) a = t} ≤ 2 ^ S.card * (∏ p ∈ S, p) := by classical let Q (p : S) (a : Residue p.1) := norm p.1 a = ZMod.castHom (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2) (ZMod p.1) t have h := card_crt_fiber_le S hprime (fun a => norm (∏ p ∈ S, p) a = t) Q (by intro a ha p change norm p.1 (reduce (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2) a) = ZMod.castHom (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2) (ZMod p.1) t rw [norm_reduce, ha]) calc Nat.card {a : Residue (∏ p ∈ S, p) // norm (∏ p ∈ S, p) a = t} ≤ ∏ p : S, Nat.card {a // Q p a} := h _ ≤ ∏ p : S, 2 * p.1 := Finset.prod_le_prod' fun p _ => card_norm_fiber_prime p.1 (hprime p.1 p.2) _ _ = 2 ^ S.card * (∏ p ∈ S, p) := by rw [Finset.prod_mul_distrib] rw [Finset.prod_const, Finset.card_univ, Fintype.card_coe, Finset.prod_coe_sort S (fun p : ℕ => p)] theorem card_norm_fiber_four_primes (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (hfour : S.card ≤ 4) (t : ZMod (∏ p ∈ S, p)) : Nat.card {a : Residue (∏ p ∈ S, p) // norm (∏ p ∈ S, p) a = t} ≤ 16 * (∏ p ∈ S, p) := by have hpow : 2 ^ S.card ≤ 2 ^ 4 := pow_le_pow_right₀ (by norm_num : (1 : ℕ) ≤ 2) hfour exact (card_norm_fiber_product S hprime t).trans (Nat.mul_le_mul_right _ (by norm_num at hpow ⊢; exact hpow)) /-- The local ratio equations are imposed on actual CRT projections of `b,c`. The number of prime factors need not be bounded for this estimate. -/ theorem card_ratio_fiber_product (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (hinert : ∀ p ∈ S, p % 4 = 3) (b c : Residue (∏ p ∈ S, p)) (hb : ∀ p : S, crtReduction S b p ≠ 0) : Nat.card {a : Residue (∏ p ∈ S, p) // a * b = conjugate (∏ p ∈ S, p) a * c} ≤ (∏ p ∈ S, p) := by classical let Q (p : S) (a : Residue p.1) := a * crtReduction S b p = conjugate p.1 a * crtReduction S c p have h := card_crt_fiber_le S hprime (fun a => a * b = conjugate (∏ p ∈ S, p) a * c) Q (by intro a ha p have he := congrArg (reduce (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2)) ha change reduce (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2) a * reduce (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2) b = conjugate p.1 (reduce (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2) a) * reduce (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2) c simpa only [map_mul, ← conjugate_reduce] using he) calc Nat.card {a : Residue (∏ p ∈ S, p) // a * b = conjugate (∏ p ∈ S, p) a * c} ≤ ∏ p : S, Nat.card {a // Q p a} := h _ ≤ ∏ p : S, p.1 := Finset.prod_le_prod' fun p _ => card_ratio_fiber_prime p.1 (hprime p.1 p.2) (by have := hinert p.1 p.2; omega) _ _ (hb p) _ = ∏ p ∈ S, p := Finset.prod_coe_sort S (fun p : ℕ => p) end DistanceCounts.GaussianResidues end end BodyFile008 -- Source: DistanceCounts/GaussianUnitCRT.lean section BodyFile009 noncomputable section namespace DistanceCounts.GaussianUnitCRT open GaussianResidues /-- The canonical quotient reductions, bundled as a ring homomorphism. -/ def crtHom (S : Finset ℕ) : Residue (∏ p ∈ S, p) →+* ∀ p : S, Residue p.1 where toFun := crtReduction S map_one' := by funext p; exact map_one (reduce _) map_mul' a b := by funext p; exact map_mul (reduce _) a b map_zero' := by funext p; exact map_zero (reduce _) map_add' a b := by funext p; exact map_add (reduce _) a b /-- Surjectivity follows from the exact cardinalities of the genuine rings. -/ theorem crtReduction_bijective (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) : Function.Bijective (crtReduction S) := by letI : ∀ p : S, Finite (Residue p.1) := fun p => finite_residue p.1 (hprime p.1 p.2).pos apply (Nat.bijective_iff_injective_and_card _).2 refine ⟨crtReduction_injective S hprime, ?_⟩ rw [card_residue, Nat.card_pi] simp_rw [card_residue] rw [Finset.prod_pow, Finset.prod_coe_sort S (fun p : ℕ => p)] /-- CRT for actual Gaussian quotient rings, not for coordinatewise products. -/ def crtEquiv (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) : Residue (∏ p ∈ S, p) ≃+* ∀ p : S, Residue p.1 := RingEquiv.ofBijective (crtHom S) (crtReduction_bijective S hprime) theorem crtEquiv_apply (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (a : Residue (∏ p ∈ S, p)) (p : S) : crtEquiv S hprime a p = reduce (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2) a := rfl /-- The induced multiplicative equivalence on the genuine unit groups. -/ def unitCRT (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) : (Residue (∏ p ∈ S, p))ˣ ≃* ∀ p : S, (Residue p.1)ˣ := (Units.mapEquiv (crtEquiv S hprime).toMulEquiv).trans MulEquiv.piUnits theorem unitCRT_apply_val (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (u : (Residue (∏ p ∈ S, p))ˣ) (p : S) : ((unitCRT S hprime u p : (Residue p.1)ˣ) : Residue p.1) = reduce (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2) (u : Residue (∏ p ∈ S, p)) := rfl theorem card_units_product (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (hinert : ∀ p ∈ S, p % 4 = 3) : Nat.card (Residue (∏ p ∈ S, p))ˣ = ∏ p ∈ S, (p ^ 2 - 1) := by letI : ∀ p : S, Finite (Residue p.1) := fun p => finite_residue p.1 (hprime p.1 p.2).pos rw [Nat.card_congr (unitCRT S hprime).toEquiv, Nat.card_pi] calc (∏ p : S, Nat.card (Residue p.1)ˣ) = ∏ p : S, (p.1 ^ 2 - 1) := Finset.prod_congr rfl fun p _ => card_unit_group_inert p.1 (hprime p.1 p.2) (hinert p.1 p.2) _ = ∏ p ∈ S, (p ^ 2 - 1) := Finset.prod_coe_sort S (fun p : ℕ => p ^ 2 - 1) /-- A lower bound with the actual number of prime factors; the empty product is included. -/ theorem card_units_lower (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (hinert : ∀ p ∈ S, p % 4 = 3) : (8 / 9 : ℝ) ^ S.card * (∏ p ∈ S, (p : ℝ)) ^ 2 ≤ (Nat.card (Residue (∏ p ∈ S, p))ˣ : ℝ) := by rw [card_units_product S hprime hinert, Nat.cast_prod] have hlocal (p : ℕ) (hp : p ∈ S) : (8 / 9 : ℝ) * (p : ℝ) ^ 2 ≤ ((p ^ 2 - 1 : ℕ) : ℝ) := by have hp3 : 3 ≤ p := by have := hinert p hp; omega have hp3r : (3 : ℝ) ≤ p := by exact_mod_cast hp3 have hp2 : 1 ≤ p ^ 2 := by nlinarith rw [Nat.cast_sub hp2, Nat.cast_pow, Nat.cast_one] nlinarith [sq_nonneg ((p : ℝ) - 3)] calc (8 / 9 : ℝ) ^ S.card * (∏ p ∈ S, (p : ℝ)) ^ 2 = ∏ p ∈ S, ((8 / 9 : ℝ) * (p : ℝ) ^ 2) := by rw [Finset.prod_mul_distrib, Finset.prod_const, Finset.prod_pow] _ ≤ ∏ p ∈ S, ((p ^ 2 - 1 : ℕ) : ℝ) := Finset.prod_le_prod (fun p _ => by positivity) hlocal /-- At most four inert factors retain at least `(8/9)^4` of all residues. -/ theorem card_units_lower_four (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (hinert : ∀ p ∈ S, p % 4 = 3) (hfour : S.card ≤ 4) : (8 / 9 : ℝ) ^ 4 * ((∏ p ∈ S, p : ℕ) : ℝ) ^ 2 ≤ (Nat.card (Residue (∏ p ∈ S, p))ˣ : ℝ) := by have hpow : (8 / 9 : ℝ) ^ 4 ≤ (8 / 9 : ℝ) ^ S.card := pow_le_pow_of_le_one (by norm_num) (by norm_num) hfour calc _ ≤ (8 / 9 : ℝ) ^ S.card * ((∏ p ∈ S, p : ℕ) : ℝ) ^ 2 := mul_le_mul_of_nonneg_right hpow (sq_nonneg _) _ ≤ _ := by simpa only [Nat.cast_prod] using card_units_lower S hprime hinert theorem half_square_le_four_fraction (q : ℕ) : (q : ℝ) ^ 2 / 2 ≤ (8 / 9 : ℝ) ^ 4 * (q : ℝ) ^ 2 := by nlinarith [sq_nonneg (q : ℝ)] theorem card_units_lower_half (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (hinert : ∀ p ∈ S, p % 4 = 3) (hfour : S.card ≤ 4) : ((∏ p ∈ S, p : ℕ) : ℝ) ^ 2 / 2 ≤ (Nat.card (Residue (∏ p ∈ S, p))ˣ : ℝ) := (half_square_le_four_fraction _).trans (card_units_lower_four S hprime hinert hfour) /-- Any fixed tuple of local units merely permutes the independent local choices. -/ def twistedUnitCRT (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (c : ∀ p : S, (Residue p.1)ˣ) : (∀ p : S, (Residue p.1)ˣ) ≃ (Residue (∏ p ∈ S, p))ˣ := (Equiv.mulLeft c).trans (unitCRT S hprime).symm.toEquiv theorem twistedUnitCRT_reduce (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (c u : ∀ p : S, (Residue p.1)ˣ) (p : S) : reduce (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2) ((twistedUnitCRT S hprime c u : (Residue (∏ p ∈ S, p))ˣ) : Residue (∏ p ∈ S, p)) = (c p : Residue p.1) * (u p : Residue p.1) := by rw [← unitCRT_apply_val S hprime] change ((unitCRT S hprime ((unitCRT S hprime).symm (c * u)) p : (Residue p.1)ˣ) : Residue p.1) = _ rw [MulEquiv.apply_symm_apply] rfl /-- Squarefree cofactors are exactly the products with one prime removed. -/ theorem cofactor_eq_prod_erase (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (p : S) : (∏ r ∈ S, r) / p.1 = ∏ r ∈ S.erase p.1, r := by apply Nat.div_eq_of_eq_mul_left (hprime p.1 p.2).pos simpa only [mul_comm] using (Finset.mul_prod_erase S (fun r : ℕ => r) p.2).symm theorem cofactor_coprime (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (p : S) : Nat.Coprime ((∏ r ∈ S, r) / p.1) p.1 := by rw [cofactor_eq_prod_erase S hprime p, Nat.coprime_prod_left_iff] intro r hr obtain ⟨hne, hrS⟩ := Finset.mem_erase.mp hr exact (Nat.coprime_primes (hprime r hrS) (hprime p.1 p.2)).2 hne /-- The cofactor is a unit in the actual local quotient; inertness is unnecessary. -/ theorem cofactor_isUnit (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (p : S) : IsUnit (((∏ r ∈ S, r) / p.1 : ℕ) : Residue p.1) := by have h : IsCoprime (((∏ r ∈ S, r) / p.1 : ℕ) : Residue p.1) (p.1 : Residue p.1) := (cofactor_coprime S hprime p).cast have hpzero : (p.1 : Residue p.1) = 0 := by have hz : GaussianNorm.residue p.1 (p.1 : GaussianInt) = 0 := Ideal.Quotient.eq_zero_iff_mem.2 (Ideal.mem_span_singleton.2 (dvd_refl _)) simpa only [GaussianNorm.residue, map_natCast] using hz rw [hpzero] at h exact isCoprime_zero_right.1 h def cofactorUnit (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (p : S) : (Residue p.1)ˣ := (cofactor_isUnit S hprime p).unit theorem cofactorUnit_val (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (p : S) : (cofactorUnit S hprime p : Residue p.1) = (((∏ r ∈ S, r) / p.1 : ℕ) : Residue p.1) := IsUnit.unit_spec _ /-- The Gaussian numerator used for the coarse offsets. -/ def numerator (S : Finset ℕ) (z : S → GaussianInt) : GaussianInt := ∑ p : S, (((∏ r ∈ S, r) / p.1 : ℕ) : GaussianInt) * z p /-- All other summands vanish modulo `p`, with the genuine squarefree cofactor. -/ theorem numerator_residue (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (z : S → GaussianInt) (p : S) : GaussianNorm.residue p.1 (numerator S z) = (((∏ r ∈ S, r) / p.1 : ℕ) : Residue p.1) * GaussianNorm.residue p.1 (z p) := by classical change (Ideal.Quotient.mk _ : GaussianInt →+* Residue p.1) (∑ r : S, (((∏ s ∈ S, s) / r.1 : ℕ) : GaussianInt) * z r) = _ rw [map_sum] calc _ = (Ideal.Quotient.mk _ : GaussianInt →+* Residue p.1) ((((∏ s ∈ S, s) / p.1 : ℕ) : GaussianInt) * z p) := by apply Finset.sum_eq_single p · intro r _ hrp have hne : p.1 ≠ r.1 := by intro h exact hrp (Subtype.ext h.symm) have hd : p.1 ∣ (∏ s ∈ S, s) / r.1 := by rw [cofactor_eq_prod_erase S hprime r] exact Finset.dvd_prod_of_mem (fun s : ℕ => s) (Finset.mem_erase.mpr ⟨hne, p.2⟩) apply Ideal.Quotient.eq_zero_iff_mem.2 apply Ideal.mem_span_singleton.2 have hcast : (p.1 : GaussianInt) ∣ (((∏ s ∈ S, s) / r.1 : ℕ) : GaussianInt) := by obtain ⟨k, hk⟩ := hd exact ⟨(k : GaussianInt), by exact_mod_cast hk⟩ exact dvd_mul_of_dvd_left hcast (z r) · simp _ = _ := by simp only [map_mul, map_natCast, GaussianNorm.residue] /-- Canonical reduction of the global numerator gives the exact local expression. -/ theorem reduce_numerator (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (z : S → GaussianInt) (p : S) : reduce (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2) (GaussianNorm.residue (∏ r ∈ S, r) (numerator S z)) = (cofactorUnit S hprime p : Residue p.1) * GaussianNorm.residue p.1 (z p) := by rw [reduce_residue, numerator_residue S hprime, cofactorUnit_val] /-- Integer-grid translations leave every prime numerator residue unchanged. -/ theorem affine_numerator_residue (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (z : S → GaussianInt) (w : GaussianInt) (p : S) : GaussianNorm.residue p.1 (numerator S z + (∏ r ∈ S, r : ℕ) * w) = (cofactorUnit S hprime p : Residue p.1) * GaussianNorm.residue p.1 (z p) := by rw [GaussianNorm.residue_add_denominator_mul p.1 (∏ r ∈ S, r) (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2), numerator_residue S hprime, cofactorUnit_val] /-- The explicit Gaussian sum realizes the unit CRT bijection on local unit choices. -/ theorem numerator_eq_twistedUnitCRT (S : Finset ℕ) (hprime : ∀ p ∈ S, p.Prime) (u : ∀ p : S, (Residue p.1)ˣ) (z : S → GaussianInt) (hz : ∀ p, GaussianNorm.residue p.1 (z p) = (u p : Residue p.1)) : GaussianNorm.residue (∏ r ∈ S, r) (numerator S z) = ((twistedUnitCRT S hprime (cofactorUnit S hprime) u : (Residue (∏ r ∈ S, r))ˣ) : Residue (∏ r ∈ S, r)) := by apply crtReduction_injective S hprime funext p change reduce _ (GaussianNorm.residue _ (numerator S z)) = reduce _ _ rw [reduce_numerator S hprime, twistedUnitCRT_reduce, hz p] end DistanceCounts.GaussianUnitCRT end end BodyFile009 -- Source: DistanceCounts/BoundedResidueLift.lean section BodyFile010 /-! Bounded set-theoretic representatives; no ring-homomorphism property is asserted. -/ noncomputable section namespace DistanceCounts.BoundedResidueLift open GaussianResidues OffsetSeparation /-- Both integer coordinates are canonical representatives from `ZMod.val`. -/ def lift (q : ℕ) (a : Residue q) : GaussianInt := ⟨((coordinates q a).1.val : ℤ), ((coordinates q a).2.val : ℤ)⟩ theorem residue_lift (q : ℕ) (hq : 0 < q) (a : Residue q) : GaussianNorm.residue q (lift q a) = a := by letI : NeZero q := ⟨ne_of_gt hq⟩ apply coordinates_injective q rw [coordinates_residue] apply Prod.ext <;> simp [lift, ZMod.natCast_zmod_val] theorem coordinate_bounds (q : ℕ) (hq : 0 < q) (a : Residue q) : (0 ≤ (lift q a).re ∧ (lift q a).re < (q : ℤ)) ∧ (0 ≤ (lift q a).im ∧ (lift q a).im < (q : ℤ)) := by letI : NeZero q := ⟨ne_of_gt hq⟩ change (0 ≤ ((coordinates q a).1.val : ℤ) ∧ ((coordinates q a).1.val : ℤ) < (q : ℤ)) ∧ (0 ≤ ((coordinates q a).2.val : ℤ) ∧ ((coordinates q a).2.val : ℤ) < (q : ℤ)) refine ⟨⟨by positivity, ?_⟩, ⟨by positivity, ?_⟩⟩ · exact_mod_cast ZMod.val_lt (coordinates q a).1 · exact_mod_cast ZMod.val_lt (coordinates q a).2 theorem rationalOffset_bounds (q : ℕ) (hq : 0 < q) (a : Residue q) : (0 ≤ (rationalOffset (lift q a) q).1 ∧ (rationalOffset (lift q a) q).1 < 1) ∧ (0 ≤ (rationalOffset (lift q a) q).2 ∧ (rationalOffset (lift q a) q).2 < 1) := by have hb := coordinate_bounds q hq a have hqQ : (0 : ℚ) < q := by exact_mod_cast hq constructor · constructor · exact div_nonneg (by exact_mod_cast hb.1.1) hqQ.le · apply (div_lt_one hqQ).mpr exact_mod_cast hb.1.2 · constructor · exact div_nonneg (by exact_mod_cast hb.2.1) hqQ.le · apply (div_lt_one hqQ).mpr exact_mod_cast hb.2.2 theorem inert_not_dvd_lift {p : ℕ} (hp : p.Prime) (hp3 : p % 4 = 3) (a : (Residue p)ˣ) : ¬(p : GaussianInt) ∣ lift p a := by apply (GaussianNorm.residue_ne_zero_iff p _).mp rw [residue_lift p hp.pos] exact (isUnit_iff_ne_zero_inert p hp hp3 (a : Residue p)).mp a.isUnit theorem projection_lift (q : ℕ) (hq : 0 < q) (L : ℤ) (a : Residue q) : (projectionNumerator L (lift q a) : ZMod q) = (L : ZMod q) * (coordinates q a).1 + (coordinates q a).2 := by letI : NeZero q := ⟨ne_of_gt hq⟩ simp [projectionNumerator, lift, ZMod.natCast_zmod_val] end DistanceCounts.BoundedResidueLift end end BodyFile010 -- Source: DistanceCounts/LatticeCount.lean section BodyFile011 /-! Uniform Gaussian lattice disk and shifted-coset counts from unit-cell volumes. -/ noncomputable section namespace DistanceCounts open Set MeasureTheory open scoped ENNReal /-- Coordinate-bounded enumeration of exactly the Gaussian integers in a closed disk. -/ def gaussianDisk (c : ℂ) (r : ℝ) : Finset GaussianInt := by classical exact (((Finset.Icc ⌊c.re - r⌋ ⌊c.re + r⌋).product (Finset.Icc ⌊c.im - r⌋ ⌊c.im + r⌋)).image (fun p : ℤ × ℤ => (⟨p.1, p.2⟩ : GaussianInt))).filter (fun z => dist (z : ℂ) c ≤ r) lemma mem_gaussianDisk (c : ℂ) (r : ℝ) (z : GaussianInt) : z ∈ gaussianDisk c r ↔ dist (z : ℂ) c ≤ r := by classical constructor · intro hz exact (Finset.mem_filter.mp hz).2 · intro hz have hx : |(z.re : ℝ) - c.re| ≤ r := by have h : |(z.re : ℝ) - c.re| ≤ dist (z : ℂ) c := by simpa only [Complex.sub_re, ← GaussianInt.intCast_re, dist_eq_norm] using Complex.abs_re_le_norm ((z : ℂ) - c) exact h.trans hz have hy : |(z.im : ℝ) - c.im| ≤ r := by have h : |(z.im : ℝ) - c.im| ≤ dist (z : ℂ) c := by simpa only [Complex.sub_im, ← GaussianInt.intCast_im, dist_eq_norm] using Complex.abs_im_le_norm ((z : ℂ) - c) exact h.trans hz have hx' := abs_le.mp hx have hy' := abs_le.mp hy apply Finset.mem_filter.mpr refine ⟨Finset.mem_image.mpr ⟨(z.re, z.im), ?_, ?_⟩, hz⟩ · apply Finset.mem_product.mpr constructor · apply Finset.mem_Icc.mpr constructor · apply Int.floor_le_iff.mpr linarith · apply Int.le_floor.mpr linarith · apply Finset.mem_Icc.mpr constructor · apply Int.floor_le_iff.mpr linarith · apply Int.le_floor.mpr linarith · cases z rfl /-- Half-open unit square whose lower-left vertex is the given lattice point. -/ def gaussianCell (z : GaussianInt) : Set ℂ := Complex.measurableEquivRealProd ⁻¹' (Ico (z.re : ℝ) ((z.re : ℝ) + 1) ×ˢ Ico (z.im : ℝ) ((z.im : ℝ) + 1)) lemma mem_gaussianCell (z : GaussianInt) (x : ℂ) : x ∈ gaussianCell z ↔ ((z.re : ℝ) ≤ x.re ∧ x.re < (z.re : ℝ) + 1) ∧ ((z.im : ℝ) ≤ x.im ∧ x.im < (z.im : ℝ) + 1) := Iff.rfl lemma measurableSet_gaussianCell (z : GaussianInt) : MeasurableSet (gaussianCell z) := (measurableSet_Ico.prod measurableSet_Ico).preimage Complex.measurableEquivRealProd.measurable lemma volume_gaussianCell (z : GaussianInt) : volume (gaussianCell z) = 1 := by rw [gaussianCell, Complex.volume_preserving_equiv_real_prod.measure_preimage (measurableSet_Ico.prod measurableSet_Ico).nullMeasurableSet] simp [Measure.volume_eq_prod] lemma disjoint_gaussianCell {z w : GaussianInt} (h : z ≠ w) : Disjoint (gaussianCell z) (gaussianCell w) := by apply Set.disjoint_left.mpr intro x hz hw rw [mem_gaussianCell] at hz hw apply h apply Zsqrtd.ext · exact (Int.floor_eq_iff.mpr hz.1).symm.trans (Int.floor_eq_iff.mpr hw.1) · exact (Int.floor_eq_iff.mpr hz.2).symm.trans (Int.floor_eq_iff.mpr hw.2) lemma dist_lt_two_of_mem_gaussianCell {z : GaussianInt} {x : ℂ} (hx : x ∈ gaussianCell z) : dist x (z : ℂ) < 2 := by rw [mem_gaussianCell] at hx have hre : 0 ≤ (x - (z : ℂ)).re := by simpa only [Complex.sub_re, ← GaussianInt.intCast_re] using sub_nonneg.mpr hx.1.1 have him : 0 ≤ (x - (z : ℂ)).im := by simpa only [Complex.sub_im, ← GaussianInt.intCast_im] using sub_nonneg.mpr hx.2.1 have hre' : (x - (z : ℂ)).re < 1 := by have h : x.re - (z.re : ℝ) < 1 := by linarith [hx.1.2] simpa only [Complex.sub_re, ← GaussianInt.intCast_re] using h have him' : (x - (z : ℂ)).im < 1 := by have h : x.im - (z.im : ℝ) < 1 := by linarith [hx.2.2] simpa only [Complex.sub_im, ← GaussianInt.intCast_im] using h have hn := Complex.norm_le_abs_re_add_abs_im (x - (z : ℂ)) rw [abs_of_nonneg hre, abs_of_nonneg him] at hn rw [dist_eq_norm] linarith lemma exists_mem_gaussianCell (x : ℂ) : ∃ z : GaussianInt, x ∈ gaussianCell z := by refine ⟨⟨⌊x.re⌋, ⌊x.im⌋⟩, ?_⟩ exact ⟨⟨Int.floor_le _, Int.lt_floor_add_one _⟩, ⟨Int.floor_le _, Int.lt_floor_add_one _⟩⟩ /-- The exact union of the unit cells belonging to a finite collection of lattice points. -/ def gaussianCells (s : Finset GaussianInt) : Set ℂ := ⋃ z ∈ s, gaussianCell z lemma volume_gaussianCells (s : Finset GaussianInt) : volume (gaussianCells s) = (s.card : ℝ≥0∞) := by classical rw [gaussianCells, measure_biUnion_finset (fun _ _ _ _ h => disjoint_gaussianCell h) (fun z _ => measurableSet_gaussianCell z)] simp [volume_gaussianCell] lemma gaussianCells_subset_ball (c : ℂ) (r : ℝ) : gaussianCells (gaussianDisk c r) ⊆ Metric.ball c (r + 2) := by intro x hx obtain ⟨z, hz, hxz⟩ := Set.mem_iUnion₂.mp hx have hz' := (mem_gaussianDisk c r z).mp hz have hx' := dist_lt_two_of_mem_gaussianCell hxz apply Metric.mem_ball.mpr calc dist x c ≤ dist x (z : ℂ) + dist (z : ℂ) c := dist_triangle _ _ _ _ < r + 2 := by linarith lemma ball_subset_gaussianCells (c : ℂ) (r : ℝ) : Metric.ball c (r - 2) ⊆ gaussianCells (gaussianDisk c r) := by intro x hx obtain ⟨z, hz⟩ := exists_mem_gaussianCell x apply Set.mem_iUnion₂.mpr refine ⟨z, (mem_gaussianDisk c r z).mpr ?_, hz⟩ have hx' := Metric.mem_ball.mp hx have hz' := dist_lt_two_of_mem_gaussianCell hz calc dist (z : ℂ) c ≤ dist (z : ℂ) x + dist x c := dist_triangle _ _ _ _ ≤ r := by rw [dist_comm (z : ℂ) x]; linarith lemma real_volume_complex_ball (c : ℂ) {r : ℝ} (hr : 0 ≤ r) : volume.real (Metric.ball c r) = Real.pi * r ^ 2 := by rw [Measure.real, Complex.volume_ball, ENNReal.toReal_mul, ENNReal.toReal_pow, ENNReal.toReal_ofReal hr] simp [mul_comm] lemma gaussianDisk_card_upper (c : ℂ) {r : ℝ} (hr : 0 ≤ r) : ((gaussianDisk c r).card : ℝ) ≤ Real.pi * (r + 2) ^ 2 := by have h := measureReal_mono (μ := volume) (gaussianCells_subset_ball c r) (by rw [Complex.volume_ball]; finiteness) rw [real_volume_complex_ball c (r := r + 2) (by linarith)] at h simpa [Measure.real, volume_gaussianCells] using h lemma gaussianDisk_card_lower (c : ℂ) {r : ℝ} (hr : 2 ≤ r) : Real.pi * (r - 2) ^ 2 ≤ ((gaussianDisk c r).card : ℝ) := by have h := measureReal_mono (μ := volume) (ball_subset_gaussianCells c r) (by rw [volume_gaussianCells]; exact ENNReal.natCast_ne_top _) rw [real_volume_complex_ball c (r := r - 2) (by linarith)] at h simpa [Measure.real, volume_gaussianCells] using h /-- A uniform, explicit shifted Gauss disk estimate, including radius zero. -/ theorem gaussianDisk_card_error (c : ℂ) {r : ℝ} (hr : 0 ≤ r) : |((gaussianDisk c r).card : ℝ) - Real.pi * r ^ 2| ≤ (4 * Real.pi) * (r + 1) := by apply abs_le.mpr constructor · by_cases hr' : 2 ≤ r · have hl := gaussianDisk_card_lower c hr' nlinarith [Real.pi_pos] · have hc : 0 ≤ ((gaussianDisk c r).card : ℝ) := Nat.cast_nonneg _ have hsq : r ^ 2 ≤ 4 := by nlinarith have hmul := mul_le_mul_of_nonneg_left hsq Real.pi_nonneg have hpr := mul_nonneg Real.pi_nonneg hr nlinarith · have hu := gaussianDisk_card_upper c hr nlinarith /-- The constant does not depend on either the radius or the complex centre. -/ theorem exists_gaussianDisk_uniform_constant : ∃ C : ℝ, 0 < C ∧ ∀ c : ℂ, ∀ r : ℝ, 0 ≤ r → |((gaussianDisk c r).card : ℝ) - Real.pi * r ^ 2| ≤ C * (r + 1) := by exact ⟨4 * Real.pi, mul_pos (by norm_num) Real.pi_pos, fun c _ hr => gaussianDisk_card_error c hr⟩ /-- Gaussian integers in the affine ideal `a + d ℤ[i]` and in the specified disk. The membership theorem below identifies this finite enumeration exactly when `d ≠ 0`. -/ def gaussianCosetDisk (a d : GaussianInt) (c : ℂ) (r : ℝ) : Finset GaussianInt := by classical exact (gaussianDisk ((c - (a : ℂ)) / (d : ℂ)) (r / ‖(d : ℂ)‖)).image (fun z => a + d * z) lemma gaussian_affine_dist (a d z : GaussianInt) (hd : d ≠ 0) (c : ℂ) : dist ((a + d * z : GaussianInt) : ℂ) c = ‖(d : ℂ)‖ * dist (z : ℂ) ((c - (a : ℂ)) / (d : ℂ)) := by have hd' : (d : ℂ) ≠ 0 := GaussianInt.toComplex_eq_zero.not.mpr hd have he : ((a + d * z : GaussianInt) : ℂ) - c = (d : ℂ) * ((z : ℂ) - (c - (a : ℂ)) / (d : ℂ)) := by rw [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, mul_sub, mul_div_cancel₀ _ hd'] ring rw [dist_eq_norm, he, norm_mul, dist_eq_norm] lemma mem_gaussianCosetDisk (a d w : GaussianInt) (hd : d ≠ 0) (c : ℂ) (r : ℝ) : w ∈ gaussianCosetDisk a d c r ↔ (∃ z : GaussianInt, a + d * z = w) ∧ dist (w : ℂ) c ≤ r := by classical have hn : 0 < ‖(d : ℂ)‖ := norm_pos_iff.mpr (GaussianInt.toComplex_eq_zero.not.mpr hd) constructor · intro hw obtain ⟨z, hz, rfl⟩ := Finset.mem_image.mp hw refine ⟨⟨z, rfl⟩, ?_⟩ rw [gaussian_affine_dist a d z hd c] have hz' := (mem_gaussianDisk _ _ z).mp hz exact (by simpa [mul_comm] using (le_div_iff₀ hn).mp hz') · rintro ⟨⟨z, rfl⟩, hz⟩ apply Finset.mem_image.mpr refine ⟨z, (mem_gaussianDisk _ _ z).mpr ?_, rfl⟩ rw [gaussian_affine_dist a d z hd c] at hz exact (le_div_iff₀ hn).mpr (by simpa [mul_comm] using hz) lemma gaussianCosetDisk_card (a d : GaussianInt) (hd : d ≠ 0) (c : ℂ) (r : ℝ) : (gaussianCosetDisk a d c r).card = (gaussianDisk ((c - (a : ℂ)) / (d : ℂ)) (r / ‖(d : ℂ)‖)).card := by classical apply Finset.card_image_of_injective intro x y h exact mul_left_cancel₀ hd (add_left_cancel h) /-- Uniform shifted-coset estimate obtained by the genuine similarity `z ↦ a + d*z`. -/ theorem gaussianCosetDisk_card_error (a d : GaussianInt) (hd : d ≠ 0) (c : ℂ) {r : ℝ} (hr : 0 ≤ r) : |((gaussianCosetDisk a d c r).card : ℝ) - Real.pi * (r / ‖(d : ℂ)‖) ^ 2| ≤ (4 * Real.pi) * (r / ‖(d : ℂ)‖ + 1) := by rw [gaussianCosetDisk_card a d hd c r] exact gaussianDisk_card_error _ (div_nonneg hr (norm_nonneg _)) end DistanceCounts end end BodyFile011 -- Source: DistanceCounts/PairModulus.lean section BodyFile012 noncomputable section namespace DistanceCounts.PairModulus open CoarseGrid OffsetSeparation GaussianResidues variable {t : ℕ} /-- Only the uncancelled row and column primes occur. -/ def primeSet (p : Fin t ⊕ Fin t → ℕ) (b c : Fin t × Fin t) : Finset ℕ := (pairSupport b c).image p def modulus (p : Fin t ⊕ Fin t → ℕ) (b c : Fin t × Fin t) : ℕ := ∏ i ∈ pairSupport b c, p i def numerator (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (b c : Fin t × Fin t) : GaussianInt := ∑ i ∈ pairSupport b c, (modulus p b c / p i : ℕ) * (pairSign b c i : GaussianInt) * z i def gridDifference {L : ℕ} (x y : GridPairs.Grid L) : GaussianInt := ⟨(x.1 : ℤ) - y.1, (x.2 : ℤ) - y.2⟩ def encodedDifference {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (i j : PinIndex t L) : GaussianInt := numerator p z i.1 j.1 + (modulus p i.1 j.1 : GaussianInt) * gridDifference i.2 j.2 theorem modulus_pos (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (b c : Fin t × Fin t) : 0 < modulus p b c := Finset.prod_pos fun i _ => (hp i).pos theorem primeSet_prime (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (b c : Fin t × Fin t) : ∀ r ∈ primeSet p b c, r.Prime := by intro r hr obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp hr exact hp i theorem primeSet_card_le_four (p : Fin t ⊕ Fin t → ℕ) (b c : Fin t × Fin t) : (primeSet p b c).card ≤ 4 := (Finset.card_image_le).trans (pairSupport_card_le_four b c) theorem modulus_eq_primeSet_prod (p : Fin t ⊕ Fin t → ℕ) (hd : Function.Injective p) (b c : Fin t × Fin t) : modulus p b c = ∏ r ∈ primeSet p b c, r := by symm exact Finset.prod_image hd.injOn theorem modulus_primeFactors (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (b c : Fin t × Fin t) : (modulus p b c).primeFactors = primeSet p b c := by rw [modulus_eq_primeSet_prod p hd] exact Nat.primeFactors_prod (primeSet_prime p hp b c) theorem modulus_primeFactors_card_le_four (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (b c : Fin t × Fin t) : (modulus p b c).primeFactors.card ≤ 4 := by rw [modulus_primeFactors p hp hd] exact primeSet_card_le_four p b c theorem pairSupport_injective (b : Fin t × Fin t) : Function.Injective (pairSupport b) := by intro c d h have ha : blockAxes c = blockAxes d := by ext k have hk := Finset.ext_iff.mp h k simp only [pairSupport, Finset.mem_union, Finset.mem_sdiff] at hk by_cases hb : k ∈ blockAxes b <;> simp only [hb, true_and, false_and, not_true_eq_false, not_false_eq_true, and_true, and_false, false_or, or_false] at hk ⊢ <;> tauto apply Prod.ext · have hk := Finset.ext_iff.mp ha (Sum.inl c.1) simpa [blockAxes] using hk.mp (by simp [blockAxes]) · have hk := Finset.ext_iff.mp ha (Sum.inr c.2) simpa [blockAxes] using hk.mp (by simp [blockAxes]) theorem modulus_injective (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (b : Fin t × Fin t) : Function.Injective (modulus p b) := by intro c d h apply pairSupport_injective b have he := congrArg Nat.primeFactors h rw [modulus_primeFactors p hp hd, modulus_primeFactors p hp hd] at he ext k have hk := Finset.ext_iff.mp he (p k) simpa [primeSet, Finset.mem_image, hd.eq_iff] using hk theorem pairSign_zero_of_not_mem (b c : Fin t × Fin t) (k : Fin t ⊕ Fin t) (hk : k ∉ pairSupport b c) : pairSign b c k = 0 := by simp only [pairSupport, Finset.mem_union, Finset.mem_sdiff] at hk by_cases hb : k ∈ blockAxes b <;> by_cases hc : k ∈ blockAxes c <;> simp_all [pairSign] theorem pairSign_eq_one_or_neg_one (b c : Fin t × Fin t) (k : Fin t ⊕ Fin t) (hk : k ∈ pairSupport b c) : pairSign b c k = 1 ∨ pairSign b c k = -1 := by rcases Finset.mem_union.mp hk with hk | hk · obtain ⟨hb, hc⟩ := Finset.mem_sdiff.mp hk simp [pairSign, hb, hc] · obtain ⟨hc, hb⟩ := Finset.mem_sdiff.mp hk simp [pairSign, hb, hc] theorem signed_sum (b c : Fin t × Fin t) (r : Fin t ⊕ Fin t → ℚ) : (∑ k ∈ pairSupport b c, (pairSign b c k : ℚ) * r k) = r (.inl b.1) + r (.inr b.2) - r (.inl c.1) - r (.inr c.2) := by classical rw [Finset.sum_subset (Finset.subset_univ _) (fun k _ hk => by rw [pairSign_zero_of_not_mem b c k hk]; simp)] have hs (k : Fin t ⊕ Fin t) : pairSign b c k = pairCoefficient (.inl b.1) (.inr b.2) (.inl c.1) (.inr c.2) k := by cases k with | inl k => simp [pairSign, blockAxes, pairCoefficient] | inr k => simp [pairSign, blockAxes, pairCoefficient] simp_rw [hs] exact pairCoefficient_sum r _ _ _ _ theorem prime_dvd_modulus (p : Fin t ⊕ Fin t → ℕ) (b c : Fin t × Fin t) (k : Fin t ⊕ Fin t) (hk : k ∈ pairSupport b c) : p k ∣ modulus p b c := Finset.dvd_prod_of_mem p hk theorem cofactor_mul (p : Fin t ⊕ Fin t → ℕ) (b c : Fin t × Fin t) (k : Fin t ⊕ Fin t) (hk : k ∈ pairSupport b c) : modulus p b c / p k * p k = modulus p b c := Nat.div_mul_cancel (prime_dvd_modulus p b c k hk) private theorem rationalOffset_sum {I : Type*} (s : Finset I) (f : I → GaussianInt) (q : ℕ) : rationalOffset (∑ i ∈ s, f i) q = ∑ i ∈ s, rationalOffset (f i) q := by classical induction s using Finset.induction_on with | empty => simp [rationalOffset] | @insert i s hi ih => rw [Finset.sum_insert hi, Finset.sum_insert hi] rw [show rationalOffset (f i + ∑ j ∈ s, f j) q = rationalOffset (f i) q + rationalOffset (∑ j ∈ s, f j) q by ext <;> simp [rationalOffset, add_div]] rw [ih] private theorem fst_sum {I : Type*} (s : Finset I) (f : I → ℚ × ℚ) : (∑ k ∈ s, f k).1 = ∑ k ∈ s, (f k).1 := by classical induction s using Finset.induction_on with | empty => simp | @insert k s hk ih => simp [Finset.sum_insert, hk, ih] private theorem snd_sum {I : Type*} (s : Finset I) (f : I → ℚ × ℚ) : (∑ k ∈ s, f k).2 = ∑ k ∈ s, (f k).2 := by classical induction s using Finset.induction_on with | empty => simp | @insert k s hk ih => simp [Finset.sum_insert, hk, ih] theorem rationalOffset_numerator (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (b c : Fin t × Fin t) : rationalOffset (numerator p z b c) (modulus p b c) = rationalOffset (z (.inl b.1)) (p (.inl b.1)) + rationalOffset (z (.inr b.2)) (p (.inr b.2)) - rationalOffset (z (.inl c.1)) (p (.inl c.1)) - rationalOffset (z (.inr c.2)) (p (.inr c.2)) := by have hq : (modulus p b c : ℚ) ≠ 0 := by exact_mod_cast (modulus_pos p hp b c).ne' have ht (k : Fin t ⊕ Fin t) (hk : k ∈ pairSupport b c) (a : ℤ) : ((modulus p b c / p k : ℕ) : ℚ) * pairSign b c k * a / modulus p b c = (pairSign b c k : ℚ) * ((a : ℚ) / p k) := by have hpk : (p k : ℚ) ≠ 0 := by exact_mod_cast (hp k).ne_zero have hm : ((modulus p b c / p k : ℕ) : ℚ) * p k = modulus p b c := by exact_mod_cast cofactor_mul p b c k hk field_simp [hq, hpk] nlinarith [congrArg (fun x : ℚ => (pairSign b c k : ℚ) * (a : ℚ) * x) hm] rw [numerator, rationalOffset_sum] apply Prod.ext · simp only [fst_sum, Prod.fst_add, Prod.fst_sub, rationalOffset, Zsqrtd.re_mul, Zsqrtd.im_mul, Zsqrtd.re_natCast, Zsqrtd.im_natCast, Zsqrtd.re_intCast, Zsqrtd.im_intCast, mul_zero, zero_mul, add_zero, Int.cast_mul, Int.cast_natCast] rw [Finset.sum_congr rfl (fun k hk => ht k hk (z k).re)] exact signed_sum b c (fun k => (z k).re / (p k : ℚ)) · simp only [snd_sum, Prod.snd_add, Prod.snd_sub, rationalOffset, Zsqrtd.re_mul, Zsqrtd.im_mul, Zsqrtd.re_natCast, Zsqrtd.im_natCast, Zsqrtd.re_intCast, Zsqrtd.im_intCast, mul_zero, zero_mul, add_zero, Int.cast_mul, Int.cast_natCast] rw [Finset.sum_congr rfl (fun k hk => ht k hk (z k).im)] exact signed_sum b c (fun k => (z k).im / (p k : ℚ)) theorem rationalPin_sub {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (i j : PinIndex t L) : rationalPin p z i.1.1 i.1.2 i.2.1 i.2.2 - rationalPin p z j.1.1 j.1.2 j.2.1 j.2.2 = rationalOffset (encodedDifference p z i j) (modulus p i.1 j.1) := by have hq : (modulus p i.1 j.1 : ℚ) ≠ 0 := by exact_mod_cast (modulus_pos p hp i.1 j.1).ne' have h := rationalOffset_numerator p z hp i.1 j.1 apply Prod.ext · have hr := congrArg Prod.fst h simp [rationalPin, encodedDifference, rationalOffset, gridDifference, integerVector, add_div, hq] at hr ⊢ linarith · have hr := congrArg Prod.snd h simp [rationalPin, encodedDifference, rationalOffset, gridDifference, integerVector, add_div, hq] at hr ⊢ linarith theorem pin_sub_coordinates {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (i j : PinIndex t L) : (pin p z i 0 - pin p z j 0 = (encodedDifference p z i j).re / (modulus p i.1 j.1 : ℝ)) ∧ (pin p z i 1 - pin p z j 1 = (encodedDifference p z i j).im / (modulus p i.1 j.1 : ℝ)) := by have h := rationalPin_sub p z hp i j constructor · have hr := congrArg Prod.fst h have hrr := congrArg (fun x : ℚ => (x : ℝ)) hr dsimp [pin, embed, planePoint] simpa [rationalOffset] using hrr · have hr := congrArg Prod.snd h have hrr := congrArg (fun x : ℚ => (x : ℝ)) hr dsimp [pin, embed, planePoint] simpa [rationalOffset] using hrr theorem sqDist_eq_normQuotient {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (i j : PinIndex t L) : sqDist (pin p z i) (pin p z j) = (GaussianNorm.normQuotient (encodedDifference p z i j) (modulus p i.1 j.1) : ℝ) := GaussianNorm.sqDist_eq_normQuotient _ _ _ _ (pin_sub_coordinates p z hp i j).1 (pin_sub_coordinates p z hp i j).2 theorem pin_sub {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (i j : PinIndex t L) : pin p z i - pin p z j = embed (rationalOffset (encodedDifference p z i j) (modulus p i.1 j.1)) := by ext k fin_cases k · simpa [embed, planePoint, rationalOffset] using (pin_sub_coordinates p z hp i j).1 · simpa [embed, planePoint, rationalOffset] using (pin_sub_coordinates p z hp i j).2 theorem cofactor_eq_prod_erase (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (b c : Fin t × Fin t) (k : Fin t ⊕ Fin t) (hk : k ∈ pairSupport b c) : modulus p b c / p k = ∏ r ∈ (pairSupport b c).erase k, p r := by apply Nat.div_eq_of_eq_mul_left (hp k).pos simpa [modulus, mul_comm] using (Finset.mul_prod_erase (pairSupport b c) p hk).symm theorem cofactor_isUnit (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (b c : Fin t × Fin t) (k : Fin t ⊕ Fin t) (hk : k ∈ pairSupport b c) : IsUnit ((modulus p b c / p k : ℕ) : Residue (p k)) := by rw [modulus_eq_primeSet_prod p hd] exact GaussianUnitCRT.cofactor_isUnit (primeSet p b c) (primeSet_prime p hp b c) ⟨p k, Finset.mem_image.mpr ⟨k, hk, rfl⟩⟩ theorem sign_isUnit (p : Fin t ⊕ Fin t → ℕ) (b c : Fin t × Fin t) (k : Fin t ⊕ Fin t) (hk : k ∈ pairSupport b c) : IsUnit (pairSign b c k : Residue (p k)) := by rcases pairSign_eq_one_or_neg_one b c k hk with h | h <;> rw [h] <;> simp /-- The sign and the cofactor are genuine units, in the prescribed orientation. -/ theorem signed_cofactor_isUnit (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (b c : Fin t × Fin t) (k : Fin t ⊕ Fin t) (hk : k ∈ pairSupport b c) : IsUnit (((modulus p b c / p k : ℕ) : Residue (p k)) * pairSign b c k) := (cofactor_isUnit p hp hd b c k hk).mul (sign_isUnit p b c k hk) theorem numerator_residue (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (b c : Fin t × Fin t) (k : Fin t ⊕ Fin t) (hk : k ∈ pairSupport b c) : GaussianNorm.residue (p k) (numerator p z b c) = ((modulus p b c / p k : ℕ) : Residue (p k)) * pairSign b c k * GaussianNorm.residue (p k) (z k) := by classical change (Ideal.Quotient.mk _ : GaussianInt →+* Residue (p k)) (∑ r ∈ pairSupport b c, _) = _ rw [map_sum] rw [Finset.sum_eq_single k] · simp only [map_mul, map_natCast, map_intCast, GaussianNorm.residue] · intro r hr hrk apply Ideal.Quotient.eq_zero_iff_mem.mpr apply Ideal.mem_span_singleton.mpr have hdvd : p k ∣ modulus p b c / p r := by rw [cofactor_eq_prod_erase p hp b c r hr] exact Finset.dvd_prod_of_mem p (Finset.mem_erase.mpr ⟨hrk.symm, hk⟩) obtain ⟨a, ha⟩ := hdvd have hc : (p k : GaussianInt) ∣ (modulus p b c / p r : ℕ) := by exact ⟨(a : GaussianInt), by exact_mod_cast ha⟩ exact dvd_mul_of_dvd_left (dvd_mul_of_dvd_left hc _) _ · exact fun h => (h hk).elim theorem encodedDifference_residue {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (i j : PinIndex t L) : GaussianNorm.residue (modulus p i.1 j.1) (encodedDifference p z i j) = GaussianNorm.residue (modulus p i.1 j.1) (numerator p z i.1 j.1) := GaussianNorm.residue_add_denominator_mul _ _ (dvd_refl _) _ _ theorem encodedDifference_local_residue {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (i j : PinIndex t L) (k : Fin t ⊕ Fin t) (hk : k ∈ pairSupport i.1 j.1) : GaussianNorm.residue (p k) (encodedDifference p z i j) = ((modulus p i.1 j.1 / p k : ℕ) : Residue (p k)) * pairSign i.1 j.1 k * GaussianNorm.residue (p k) (z k) := by rw [encodedDifference, GaussianNorm.residue_add_denominator_mul (p k) (modulus p i.1 j.1) (prime_dvd_modulus p i.1 j.1 k hk)] exact numerator_residue p z hp hd i.1 j.1 k hk theorem numerator_isUnit (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (b c : Fin t × Fin t) (hz : ∀ k ∈ pairSupport b c, IsUnit (GaussianNorm.residue (p k) (z k))) : IsUnit (GaussianNorm.residue (modulus p b c) (numerator p z b c)) := by rw [modulus_eq_primeSet_prod p hd] let e := GaussianUnitCRT.crtEquiv (primeSet p b c) (primeSet_prime p hp b c) have hu : IsUnit (e (GaussianNorm.residue (∏ r ∈ primeSet p b c, r) (numerator p z b c))) := by apply Pi.isUnit_iff.mpr intro r change IsUnit (reduce (Finset.dvd_prod_of_mem (fun x : ℕ => x) r.2) (GaussianNorm.residue (∏ r ∈ primeSet p b c, r) (numerator p z b c))) rw [reduce_residue] obtain ⟨k, hk, he⟩ := Finset.mem_image.mp r.2 cases r with | mk r hr => dsimp at he ⊢ subst r rw [numerator_residue p z hp hd b c k hk] exact (signed_cofactor_isUnit p hp hd b c k hk).mul (hz k hk) have hn := hu.map e.symm.toMonoidHom change IsUnit (e.symm (e (GaussianNorm.residue (∏ r ∈ primeSet p b c, r) (numerator p z b c)))) at hn simpa only [RingEquiv.symm_apply_apply] using hn theorem encodedDifference_isUnit {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (i j : PinIndex t L) (hz : ∀ k ∈ pairSupport i.1 j.1, IsUnit (GaussianNorm.residue (p k) (z k))) : IsUnit (GaussianNorm.residue (modulus p i.1 j.1) (encodedDifference p z i j)) := by rw [encodedDifference_residue] exact numerator_isUnit p z hp hd i.1 j.1 hz /-- Independent local unit choices indexed by the actual uncancelled axes. -/ abbrev LocalUnits (p : Fin t ⊕ Fin t → ℕ) (b c : Fin t × Fin t) := ∀ k : pairSupport b c, (Residue (p k.1))ˣ def localLift (p : Fin t ⊕ Fin t → ℕ) (b c : Fin t × Fin t) (u : LocalUnits p b c) (k : Fin t ⊕ Fin t) : GaussianInt := if hk : k ∈ pairSupport b c then BoundedResidueLift.lift (p k) (u ⟨k, hk⟩) else 0 theorem localLift_residue (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (b c : Fin t × Fin t) (u : LocalUnits p b c) (k : pairSupport b c) : GaussianNorm.residue (p k.1) (localLift p b c u k.1) = (u k : Residue (p k.1)) := by simp only [localLift, dif_pos k.2] exact BoundedResidueLift.residue_lift _ (hp k.1).pos _ /-- This lands in the actual global Gaussian quotient, not a tuple surrogate. -/ def localChoiceMap (p : Fin t ⊕ Fin t → ℕ) (b c : Fin t × Fin t) (u : LocalUnits p b c) : Residue (modulus p b c) := GaussianNorm.residue (modulus p b c) (numerator p (localLift p b c u) b c) theorem localChoiceMap_isUnit (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (b c : Fin t × Fin t) (u : LocalUnits p b c) : IsUnit (localChoiceMap p b c u) := by apply numerator_isUnit p _ hp hd intro k hk rw [localLift_residue p hp b c u ⟨k, hk⟩] exact (u ⟨k, hk⟩).isUnit theorem localChoiceMap_injective (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (b c : Fin t × Fin t) : Function.Injective (localChoiceMap p b c) := by intro u v huv funext k apply Units.ext have h := congrArg (reduce (prime_dvd_modulus p b c k.1 k.2)) huv change reduce _ (GaussianNorm.residue _ _) = reduce _ (GaussianNorm.residue _ _) at h rw [reduce_residue, reduce_residue, numerator_residue p _ hp hd b c k.1 k.2, numerator_residue p _ hp hd b c k.1 k.2, localLift_residue p hp b c u k, localLift_residue p hp b c v k] at h exact (signed_cofactor_isUnit p hp hd b c k.1 k.2).mul_left_cancel h def localChoiceEmbedding (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (b c : Fin t × Fin t) : LocalUnits p b c ↪ Residue (modulus p b c) where toFun := localChoiceMap p b c inj' := localChoiceMap_injective p hp hd b c /-- The CRT map does not depend on which Gaussian representatives are used. -/ theorem localChoiceMap_eq_numerator (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (b c : Fin t × Fin t) (u : LocalUnits p b c) (z : Fin t ⊕ Fin t → GaussianInt) (hz : ∀ k : pairSupport b c, GaussianNorm.residue (p k.1) (z k.1) = (u k : Residue (p k.1))) : localChoiceMap p b c u = GaussianNorm.residue (modulus p b c) (numerator p z b c) := by unfold localChoiceMap rw [modulus_eq_primeSet_prod p hd] apply crtReduction_injective (primeSet p b c) (primeSet_prime p hp b c) funext r change reduce _ (GaussianNorm.residue _ _) = reduce _ (GaussianNorm.residue _ _) rw [reduce_residue, reduce_residue] obtain ⟨k, hk, he⟩ := Finset.mem_image.mp r.2 cases r with | mk r hr => dsimp at he ⊢ subst r rw [numerator_residue p _ hp hd b c k hk, numerator_residue p _ hp hd b c k hk, localLift_residue p hp b c u ⟨k, hk⟩, hz ⟨k, hk⟩] /-- A fixed pin and target block retain every target-grid point distinctly. -/ theorem encodedDifference_injective {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (i : PinIndex t L) (c : Fin t × Fin t) : Function.Injective (fun y : GridPairs.Grid L => encodedDifference p z i (c, y)) := by intro x y h have hq : (modulus p i.1 c : GaussianInt) ≠ 0 := by intro he have hr := congrArg Zsqrtd.re he simp only [Zsqrtd.re_natCast, Zsqrtd.re_zero] at hr exact (modulus_pos p hp i.1 c).ne' (by exact_mod_cast hr) have hg : gridDifference i.2 x = gridDifference i.2 y := mul_left_cancel₀ hq (add_left_cancel h) apply Prod.ext <;> apply Fin.ext · have hr := congrArg Zsqrtd.re hg dsimp [gridDifference] at hr exact_mod_cast (sub_right_inj.mp hr) · have hr := congrArg Zsqrtd.im hg dsimp [gridDifference] at hr exact_mod_cast (sub_right_inj.mp hr) theorem encodedDifference_coprime {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hinert : ∀ k, p k % 4 = 3) (i j : PinIndex t L) (hz : ∀ k ∈ pairSupport i.1 j.1, IsUnit (GaussianNorm.residue (p k) (z k))) : Nat.Coprime (encodedDifference p z i j).norm.natAbs (modulus p i.1 j.1) := by rw [modulus_eq_primeSet_prod p hd] apply GaussianNorm.coprime_norm_prime_product_of_units _ _ (primeSet_prime p hp i.1 j.1) · intro r hr obtain ⟨k, _, rfl⟩ := Finset.mem_image.mp hr exact hinert k · intro r hr obtain ⟨k, hk, rfl⟩ := Finset.mem_image.mp hr rw [encodedDifference_local_residue p z hp hd i j k hk] exact (signed_cofactor_isUnit p hp hd i.1 j.1 k hk).mul (hz k hk) theorem normQuotient_den {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hinert : ∀ k, p k % 4 = 3) (i j : PinIndex t L) (hz : ∀ k ∈ pairSupport i.1 j.1, IsUnit (GaussianNorm.residue (p k) (z k))) : (GaussianNorm.normQuotient (encodedDifference p z i j) (modulus p i.1 j.1)).den = (modulus p i.1 j.1) ^ 2 := GaussianNorm.normQuotient_den _ _ (modulus_pos p hp i.1 j.1) (encodedDifference_coprime p z hp hd hinert i j hz) /-- Different target blocks have disjoint squared-distance palettes from a fixed pin, because their genuinely reduced denominators differ. -/ theorem sqDist_ne_of_targetBlock_ne {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hinert : ∀ k, p k % 4 = 3) (hz : ∀ k, IsUnit (GaussianNorm.residue (p k) (z k))) (i j k : PinIndex t L) (hjk : j.1 ≠ k.1) : sqDist (pin p z i) (pin p z j) ≠ sqDist (pin p z i) (pin p z k) := by rw [sqDist_eq_normQuotient p z hp, sqDist_eq_normQuotient p z hp] apply GaussianNorm.normQuotient_real_ne _ _ _ _ (modulus_pos p hp i.1 j.1) (modulus_pos p hp i.1 k.1) · exact fun h => hjk (modulus_injective p hp hd i.1 h) · exact encodedDifference_coprime p z hp hd hinert i j (fun r _ => hz r) · exact encodedDifference_coprime p z hp hd hinert i k (fun r _ => hz r) /-- The bounded-lift hypothesis is on the physical rational offsets. -/ def BoundedOffsets (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) : Prop := ∀ k, (0 ≤ (rationalOffset (z k) (p k)).1 ∧ (rationalOffset (z k) (p k)).1 < 1) ∧ (0 ≤ (rationalOffset (z k) (p k)).2 ∧ (rationalOffset (z k) (p k)).2 < 1) theorem boundedOffsets_lift (p : Fin t ⊕ Fin t → ℕ) (hp : ∀ i, (p i).Prime) (u : ∀ k, Residue (p k)) : BoundedOffsets p (fun k => BoundedResidueLift.lift (p k) (u k)) := fun k => BoundedResidueLift.rationalOffset_bounds (p k) (hp k).pos (u k) private theorem scalar_pin_bounds {L : ℕ} (a b : ℚ) (x : Fin L) (ha : 0 ≤ a ∧ a < 1) (hb : 0 ≤ b ∧ b < 1) : 0 ≤ a + b + (x : ℕ) ∧ a + b + (x : ℕ) < (L : ℚ) + 1 := by have hx : (x : ℚ) ≤ (L : ℚ) - 1 := by have hn : x.val + 1 ≤ L := x.isLt exact_mod_cast (show (x.val : ℤ) ≤ (L : ℤ) - 1 by omega) constructor · exact add_nonneg (add_nonneg ha.1 hb.1) (Nat.cast_nonneg _) · linarith [ha.2, hb.2] theorem rationalPin_bounds {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hz : BoundedOffsets p z) (i : PinIndex t L) : (0 ≤ (rationalPin p z i.1.1 i.1.2 i.2.1 i.2.2).1 ∧ (rationalPin p z i.1.1 i.1.2 i.2.1 i.2.2).1 < (L : ℚ) + 1) ∧ (0 ≤ (rationalPin p z i.1.1 i.1.2 i.2.1 i.2.2).2 ∧ (rationalPin p z i.1.1 i.1.2 i.2.1 i.2.2).2 < (L : ℚ) + 1) := by constructor · simpa [rationalPin, integerVector] using scalar_pin_bounds _ _ i.2.1 (hz (.inl i.1.1)).1 (hz (.inr i.1.2)).1 · simpa [rationalPin, integerVector] using scalar_pin_bounds _ _ i.2.2 (hz (.inl i.1.1)).2 (hz (.inr i.1.2)).2 private theorem scaled_coordinate_bound (q L a b x : ℝ) (hq : 0 < q) (hL : 1 ≤ L) (ha : 0 ≤ a ∧ a < L + 1) (hb : 0 ≤ b ∧ b < L + 1) (hx : a - b = x / q) : |x| ≤ 3 * q * L := by have hab : |a - b| ≤ 3 * L := abs_le.mpr ⟨by linarith, by linarith⟩ have he : x = q * (a - b) := by have he := (eq_div_iff hq.ne').mp hx linarith rw [he, abs_mul, abs_of_pos hq] nlinarith /-- One common genuine Gaussian disk contains every numerator, independently of the selected residue classes and of both integer-grid coordinates. -/ theorem encodedDifference_mem_disk {L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hz : BoundedOffsets p z) (hL : 0 < L) (i j : PinIndex t L) : encodedDifference p z i j ∈ gaussianDisk 0 (6 * (modulus p i.1 j.1 : ℝ) * L) := by have hi := rationalPin_bounds p z hz i have hj := rationalPin_bounds p z hz j have hir : 0 ≤ pin p z i 0 ∧ pin p z i 0 < (L : ℝ) + 1 := by dsimp [pin, embed, planePoint] exact_mod_cast hi.1 have hii : 0 ≤ pin p z i 1 ∧ pin p z i 1 < (L : ℝ) + 1 := by dsimp [pin, embed, planePoint] exact_mod_cast hi.2 have hjr : 0 ≤ pin p z j 0 ∧ pin p z j 0 < (L : ℝ) + 1 := by dsimp [pin, embed, planePoint] exact_mod_cast hj.1 have hji : 0 ≤ pin p z j 1 ∧ pin p z j 1 < (L : ℝ) + 1 := by dsimp [pin, embed, planePoint] exact_mod_cast hj.2 have hq : (0 : ℝ) < modulus p i.1 j.1 := by exact_mod_cast modulus_pos p hp i.1 j.1 have hLr : (1 : ℝ) ≤ L := by exact_mod_cast (show 1 ≤ L by omega) have hx := scaled_coordinate_bound _ _ _ _ _ hq hLr hir hjr (pin_sub_coordinates p z hp i j).1 have hy := scaled_coordinate_bound _ _ _ _ _ hq hLr hii hji (pin_sub_coordinates p z hp i j).2 rw [mem_gaussianDisk, dist_zero_right] have hn := Complex.norm_le_abs_re_add_abs_im (encodedDifference p z i j : ℂ) rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at hn linarith end DistanceCounts.PairModulus end end BodyFile012 -- Source: DistanceCounts/Degrees.lean section BodyFile013 /-! The exact cancelled-index threshold degrees and their distinct good-block values. -/ noncomputable section namespace DistanceCounts /-- The coarse-degree expression uses integers: subtraction is never truncated. -/ def coarseDegree (s a b : ℕ) : ℤ := (2 * s : ℕ) * (a : ℤ) + (b : ℤ) - (if s ≤ a then (2 * s : ℕ) else 0) - (if s ≤ b then 1 else 0) /-- The actual high-neighbor rule, with shared row and column indices cancelled. -/ def highTargets (s a b : ℕ) : Finset (ℕ × ℕ) := ((Finset.range (2 * s)) ×ˢ (Finset.range (2 * s))).filter fun cd => a ≠ cd.1 ∧ (if b = cd.2 then 2 * s ≤ a + cd.1 else (2 * s) ^ 2 ≤ (a + cd.1) * (2 * s) + b + cd.2) lemma threshold_iff {t a b c d : ℕ} (ht : 0 < t) (hb : b < t) (hd : d < t) : t ^ 2 ≤ (a + c) * t + b + d ↔ t ≤ a + c ∨ (a + c + 1 = t ∧ t ≤ b + d) := by constructor · intro h by_cases hlarge : t ≤ a + c · exact Or.inl hlarge · right have hedge : a + c + 1 = t := by by_contra hne have hgap : a + c + 2 ≤ t := by omega have hm := Nat.mul_le_mul_right t hgap nlinarith constructor · exact hedge · nlinarith · rintro (h | ⟨he, hb⟩) · have hm := Nat.mul_le_mul_right t h nlinarith · nlinarith lemma high_rule_iff {t a b c d : ℕ} (ht : 0 < t) (hb : b < t) (hd : d < t) : (if b = d then t ≤ a + c else t ^ 2 ≤ (a + c) * t + b + d) ↔ t ≤ a + c ∨ (a + c + 1 = t ∧ t ≤ b + d ∧ b ≠ d) := by by_cases hbd : b = d · simp [hbd] · simp only [hbd, if_false, threshold_iff ht hb hd] tauto lemma card_tail_erase {s a : ℕ} (ha : a < 2 * s) : ((Finset.Ico (2 * s - a) (2 * s)).erase a).card = a - (if s ≤ a then 1 else 0) := by have hcard : (Finset.Ico (2 * s - a) (2 * s)).card = a := by rw [Nat.card_Ico] omega have hmem : a ∈ Finset.Ico (2 * s - a) (2 * s) ↔ s ≤ a := by simp only [Finset.mem_Ico] omega by_cases hsa : s ≤ a · rw [Finset.card_erase_of_mem (hmem.mpr hsa), hcard, if_pos hsa] · have hnot : a ∉ Finset.Ico (2 * s - a) (2 * s) := fun h => hsa (hmem.mp h) rw [Finset.erase_eq_of_notMem hnot, hcard, if_neg hsa, Nat.sub_zero] /-- The finite high-neighbor count itself, before any analytic approximation. -/ theorem card_highTargets {s a b : ℕ} (hs : 0 < s) (ha : a < 2 * s) (hb : b < 2 * s) : ((highTargets s a b).card : ℤ) = coarseDegree s a b := by let A := (Finset.Ico (2 * s - a) (2 * s)).erase a let D := (Finset.Ico (2 * s - b) (2 * s)).erase b let c₀ := 2 * s - 1 - a have hc₀ : c₀ < 2 * s ∧ a + c₀ + 1 = 2 * s ∧ a ≠ c₀ := by dsimp [c₀] omega have hdecomp : highTargets s a b = (A ×ˢ Finset.range (2 * s)) ∪ ({c₀} ×ˢ D) := by ext cd simp only [highTargets, Finset.mem_filter, Finset.mem_product, Finset.mem_range, Finset.mem_union, Finset.mem_singleton, A, D, Finset.mem_erase, Finset.mem_Ico] constructor · rintro ⟨⟨hc, hd⟩, hac, hh⟩ have hh' := (high_rule_iff (by omega : 0 < 2 * s) hb hd).mp hh rcases hh' with hh' | ⟨hedge, hbd, hne⟩ · left omega · right omega · intro hh have hd : cd.2 < 2 * s := by rcases hh with hh | hh <;> omega refine ⟨?_, ?_, (high_rule_iff (by omega : 0 < 2 * s) hb hd).mpr ?_⟩ · rcases hh with hh | hh <;> omega · rcases hh with hh | hh <;> omega · rcases hh with hh | hh · left omega · right omega have hdisj : Disjoint (A ×ˢ Finset.range (2 * s)) ({c₀} ×ˢ D) := by apply Finset.disjoint_left.mpr intro cd hA hD simp only [Finset.mem_product, A, Finset.mem_erase, Finset.mem_Ico, Finset.mem_singleton] at hA hD omega have hcard : (highTargets s a b).card = (a - (if s ≤ a then 1 else 0)) * (2 * s) + (b - (if s ≤ b then 1 else 0)) := by rw [hdecomp, Finset.card_union_of_disjoint hdisj] simp only [Finset.card_product, Finset.card_range, Finset.card_singleton, one_mul, A, D, card_tail_erase ha, card_tail_erase hb] rw [hcard] have hA : (a - (if s ≤ a then 1 else 0) : ℕ) + (if s ≤ a then 1 else 0) = a := by split_ifs <;> omega have hD : (b - (if s ≤ b then 1 else 0) : ℕ) + (if s ≤ b then 1 else 0) = b := by split_ifs <;> omega have hAz : ((a - (if s ≤ a then 1 else 0) : ℕ) : ℤ) = (a : ℤ) - (if s ≤ a then 1 else 0) := by split_ifs at hA ⊢ <;> omega have hDz : ((b - (if s ≤ b then 1 else 0) : ℕ) : ℤ) = (b : ℤ) - (if s ≤ b then 1 else 0) := by split_ifs at hD ⊢ <;> omega rw [Nat.cast_add, Nat.cast_mul, hAz, hDz] unfold coarseDegree split_ifs <;> push_cast <;> ring /-- Delete the repeated index at the middle of the degree parametrization. -/ def squeezedIndex (s a : ℕ) : ℕ := if a < s then a else a - 1 lemma squeezedIndex_injective {s a c : ℕ} (ha : a ≠ s) (hc : c ≠ s) (h : squeezedIndex s a = squeezedIndex s c) : a = c := by unfold squeezedIndex at h split_ifs at h <;> omega lemma squeezedIndex_lt {s a : ℕ} (hs : 0 < s) (ha : a < 2 * s) : squeezedIndex s a < 2 * s := by unfold squeezedIndex split_ifs <;> omega lemma coarseDegree_eq_radix {s a b : ℕ} (hs : 0 < s) : coarseDegree s a b = (2 * s : ℕ) * (squeezedIndex s a : ℤ) + (squeezedIndex s b : ℤ) := by have hidx (k : ℕ) : (squeezedIndex s k : ℤ) = (k : ℤ) - (if s ≤ k then 1 else 0) := by unfold squeezedIndex split_ifs <;> omega rw [hidx, hidx] unfold coarseDegree split_ifs <;> push_cast <;> ring /-- Distinct good block indices have distinct assigned coarse degrees. -/ theorem coarseDegree_injective {s a b c d : ℕ} (hs : 0 < s) (ha : a < 2 * s) (hb : b < 2 * s) (hc : c < 2 * s) (hd : d < 2 * s) (has : a ≠ s) (hbs : b ≠ s) (hcs : c ≠ s) (hds : d ≠ s) (h : coarseDegree s a b = coarseDegree s c d) : a = c ∧ b = d := by rw [coarseDegree_eq_radix hs, coarseDegree_eq_radix hs] at h have hb' := squeezedIndex_lt hs hb have hd' := squeezedIndex_lt hs hd have hs' : (0 : ℤ) < (2 * s : ℕ) := by omega have hA : squeezedIndex s a = squeezedIndex s c := by by_contra hne rcases lt_or_gt_of_ne hne with hlt | hgt · have hstep : (squeezedIndex s a : ℤ) + 1 ≤ squeezedIndex s c := by omega have hm := mul_le_mul_of_nonneg_left hstep hs'.le have hbz : (squeezedIndex s b : ℤ) < (2 * s : ℕ) := by exact_mod_cast hb' have hdz : (0 : ℤ) ≤ squeezedIndex s d := by omega nlinarith · have hstep : (squeezedIndex s c : ℤ) + 1 ≤ squeezedIndex s a := by omega have hm := mul_le_mul_of_nonneg_left hstep hs'.le have hdz : (squeezedIndex s d : ℤ) < (2 * s : ℕ) := by exact_mod_cast hd' have hbz : (0 : ℤ) ≤ squeezedIndex s b := by omega nlinarith have hB : squeezedIndex s b = squeezedIndex s d := by rw [hA] at h exact_mod_cast (add_left_cancel h) exact ⟨squeezedIndex_injective has hcs hA, squeezedIndex_injective hbs hds hB⟩ def goodBlockIndices (s : ℕ) : Finset (ℕ × ℕ) := ((Finset.range (2 * s)).erase s) ×ˢ ((Finset.range (2 * s)).erase s) def goodDegreeSet (s : ℕ) : Finset ℤ := (goodBlockIndices s).image (fun ab => coarseDegree s ab.1 ab.2) lemma card_goodBlockIndices {s : ℕ} (hs : 0 < s) : (goodBlockIndices s).card = (2 * s - 1) ^ 2 := by have hmem : s ∈ Finset.range (2 * s) := Finset.mem_range.mpr (by omega) simp [goodBlockIndices, Finset.card_erase_of_mem hmem, pow_two] /-- The assigned degrees of the good blocks form a set of exactly `(t-1)^2` values. -/ theorem card_goodDegreeSet {s : ℕ} (hs : 0 < s) : (goodDegreeSet s).card = (2 * s - 1) ^ 2 := by have hinj : Set.InjOn (fun ab : ℕ × ℕ => coarseDegree s ab.1 ab.2) (goodBlockIndices s) := by intro ab hab cd hcd heq change ab ∈ goodBlockIndices s at hab change cd ∈ goodBlockIndices s at hcd simp only [goodBlockIndices, Finset.mem_product, Finset.mem_erase, Finset.mem_range] at hab hcd obtain ⟨ha, hb⟩ := hab obtain ⟨hc, hd⟩ := hcd obtain ⟨hac, hbd⟩ := coarseDegree_injective hs ha.2 hb.2 hc.2 hd.2 ha.1 hb.1 hc.1 hd.1 heq exact Prod.ext hac hbd exact (Finset.card_image_of_injOn hinj).trans (card_goodBlockIndices hs) end DistanceCounts end end BodyFile013 -- Source: DistanceCounts/ThresholdWeights.lean section BodyFile014 noncomputable section namespace DistanceCounts.ThresholdWeights /-- The first row and first column deliberately have the same positive weight. -/ def weight {t : ℕ} : Fin t ⊕ Fin t → ℝ | .inl a => Real.log 2 * ((a.val : ℝ) * t + 1 / 8) / (t : ℝ) ^ 2 | .inr b => Real.log 2 * ((b.val : ℝ) + 1 / 8) / (t : ℝ) ^ 2 theorem weight_pos {t : ℕ} (ht : 0 < t) (i : Fin t ⊕ Fin t) : 0 < weight i := by have ht' : (0 : ℝ) < t := by exact_mod_cast ht have hlog : (0 : ℝ) < Real.log 2 := Real.log_pos (by norm_num) cases i with | inl a => exact div_pos (mul_pos hlog (by positivity)) (pow_pos ht' 2) | inr b => exact div_pos (mul_pos hlog (by positivity)) (pow_pos ht' 2) /-- Only indices surviving cancellation contribute to the modulus exponent. -/ def pairExponent {t : ℕ} (b c : Fin t × Fin t) : ℝ := ∑ i ∈ CoarseGrid.pairSupport b c, weight i /-- Row and column cancellations are independent, including the self block. -/ theorem pairExponent_eq {t : ℕ} (b c : Fin t × Fin t) : pairExponent b c = (if b.1 = c.1 then 0 else weight (.inl b.1) + weight (.inl c.1)) + (if b.2 = c.2 then 0 else weight (.inr b.2) + weight (.inr c.2)) := by classical have hsupport : CoarseGrid.pairSupport b c = (if b.1 = c.1 then ∅ else {Sum.inl b.1, Sum.inl c.1}) ∪ (if b.2 = c.2 then ∅ else {Sum.inr b.2, Sum.inr c.2}) := by ext i cases i <;> by_cases hr : b.1 = c.1 <;> by_cases hc : b.2 = c.2 <;> simp [CoarseGrid.pairSupport, CoarseGrid.blockAxes, hr, hc] <;> aesop have hdisj : Disjoint (if b.1 = c.1 then (∅ : Finset (Fin t ⊕ Fin t)) else {Sum.inl b.1, Sum.inl c.1}) (if b.2 = c.2 then ∅ else {Sum.inr b.2, Sum.inr c.2}) := by apply Finset.disjoint_left.mpr intro i cases i <;> by_cases hr : b.1 = c.1 <;> by_cases hc : b.2 = c.2 <;> simp [hr, hc] unfold pairExponent rw [hsupport, Finset.sum_union hdisj] by_cases hr : b.1 = c.1 <;> by_cases hc : b.2 = c.2 <;> simp [hr, hc, eq_comm] theorem pairExponent_self {t : ℕ} (b : Fin t × Fin t) : pairExponent b b = 0 := by simp [pairExponent_eq] /-- An integer part plus a quarter for each uncancelled pair of axes. -/ def pairNumerator {t : ℕ} (b c : Fin t × Fin t) : ℝ := (if b.1 = c.1 then 0 else ((b.1.val : ℝ) + c.1.val) * t + 1 / 4) + (if b.2 = c.2 then 0 else (b.2.val : ℝ) + c.2.val + 1 / 4) theorem pairExponent_formula {t : ℕ} (b c : Fin t × Fin t) : pairExponent b c = Real.log 2 * pairNumerator b c / (t : ℝ) ^ 2 := by rw [pairExponent_eq] unfold pairNumerator split_ifs <;> simp [weight] <;> ring private theorem shifted_nat_threshold (n m : ℕ) {δ : ℝ} (hδ : 0 < δ) (hδ' : δ < 1) : (n : ℝ) + δ ≠ (m : ℝ) ∧ ((m : ℝ) < n + δ ↔ m ≤ n) := by by_cases h : m ≤ n · have h' : (m : ℝ) ≤ n := by exact_mod_cast h constructor · linarith · constructor · intro _; exact h · intro _; linarith · have hn : n + 1 ≤ m := by omega have hn' : (n : ℝ) + 1 ≤ m := by exact_mod_cast hn constructor · linarith · constructor · intro hh; linarith · intro hh; exact (h hh).elim /-- Arithmetic classification, proved from the actual cancelled numerator. -/ theorem pairNumerator_threshold {s : ℕ} (hs : 0 < s) (b c : Fin (2 * s) × Fin (2 * s)) : pairNumerator b c ≠ ((2 * s : ℕ) : ℝ) ^ 2 ∧ ((((2 * s : ℕ) : ℝ) ^ 2 < pairNumerator b c) ↔ (c.1.val, c.2.val) ∈ DistanceCounts.highTargets s b.1.val b.2.val) := by have ht : 0 < 2 * s := by omega have ht' : (2 : ℝ) ≤ (2 * s : ℕ) := by exact_mod_cast (show 2 ≤ 2 * s by omega) have hrval : b.1.val = c.1.val ↔ b.1 = c.1 := Fin.val_inj have hcval : b.2.val = c.2.val ↔ b.2 = c.2 := Fin.val_inj by_cases hr : b.1 = c.1 · have hlow : pairNumerator b c < ((2 * s : ℕ) : ℝ) ^ 2 := by by_cases hc : b.2 = c.2 · simp only [pairNumerator, hr, hc, if_true, zero_add] positivity · have hsum : b.2.val + c.2.val + 2 ≤ 2 * (2 * s) := by have hb := b.2.isLt have hc' := c.2.isLt omega have hsum' : (b.2.val : ℝ) + c.2.val + 2 ≤ 2 * (2 * s : ℕ) := by exact_mod_cast hsum simp only [pairNumerator, hr, hc, if_true, if_false, zero_add] nlinarith refine ⟨ne_of_lt hlow, ?_⟩ have hnot : (c.1.val, c.2.val) ∉ DistanceCounts.highTargets s b.1.val b.2.val := by simp [DistanceCounts.highTargets, hrval, hr] exact iff_of_false (not_lt_of_ge hlow.le) hnot · by_cases hc : b.2 = c.2 · have hshift := shifted_nat_threshold ((b.1.val + c.1.val) * (2 * s)) ((2 * s) ^ 2) (δ := (1 / 4 : ℝ)) (by norm_num) (by norm_num) have hnum : pairNumerator b c = (((b.1.val + c.1.val) * (2 * s) : ℕ) : ℝ) + 1 / 4 := by simp [pairNumerator, hr, hc] have hmul : (2 * s) ^ 2 ≤ (b.1.val + c.1.val) * (2 * s) ↔ 2 * s ≤ b.1.val + c.1.val := by constructor <;> intro h · by_contra hn have hlt : b.1.val + c.1.val < 2 * s := by omega have hm := Nat.mul_lt_mul_of_pos_right hlt ht nlinarith · have hm := Nat.mul_le_mul_right (2 * s) h nlinarith have hmem : (c.1.val, c.2.val) ∈ DistanceCounts.highTargets s b.1.val b.2.val ↔ 2 * s ≤ b.1.val + c.1.val := by simp [DistanceCounts.highTargets, c.1.isLt, c.2.isLt, hrval, hcval, hr, hc] rw [hnum] rw [Nat.cast_pow] at hshift exact ⟨hshift.1, hshift.2.trans (hmul.trans hmem.symm)⟩ · have hshift := shifted_nat_threshold ((b.1.val + c.1.val) * (2 * s) + b.2.val + c.2.val) ((2 * s) ^ 2) (δ := (1 / 2 : ℝ)) (by norm_num) (by norm_num) have hnum : pairNumerator b c = (((b.1.val + c.1.val) * (2 * s) + b.2.val + c.2.val : ℕ) : ℝ) + 1 / 2 := by simp only [pairNumerator, hr, hc, if_false, Nat.cast_add, Nat.cast_mul] ring have hmem : (c.1.val, c.2.val) ∈ DistanceCounts.highTargets s b.1.val b.2.val ↔ (2 * s) ^ 2 ≤ (b.1.val + c.1.val) * (2 * s) + b.2.val + c.2.val := by simp [DistanceCounts.highTargets, c.1.isLt, c.2.isLt, hrval, hcval, hr, hc] rw [hnum] rw [Nat.cast_pow] at hshift exact ⟨hshift.1, hshift.2.trans hmem.symm⟩ theorem pairExponent_ne_log_two {s : ℕ} (hs : 0 < s) (b c : Fin (2 * s) × Fin (2 * s)) : pairExponent b c ≠ Real.log 2 := by have hden : (0 : ℝ) < ((2 * s : ℕ) : ℝ) ^ 2 := by positivity have hlog : (0 : ℝ) < Real.log 2 := Real.log_pos (by norm_num) intro heq rw [pairExponent_formula, div_eq_iff hden.ne'] at heq exact (pairNumerator_threshold hs b c).1 ((mul_left_cancel₀ hlog.ne') heq) /-- Exact high/low classification; no geometric threshold assumption is needed. -/ theorem log_two_lt_pairExponent_iff {s : ℕ} (hs : 0 < s) (b c : Fin (2 * s) × Fin (2 * s)) : Real.log 2 < pairExponent b c ↔ (c.1.val, c.2.val) ∈ DistanceCounts.highTargets s b.1.val b.2.val := by have hden : (0 : ℝ) < ((2 * s : ℕ) : ℝ) ^ 2 := by positivity have hlog : (0 : ℝ) < Real.log 2 := Real.log_pos (by norm_num) rw [pairExponent_formula, lt_div_iff₀ hden, mul_lt_mul_iff_right₀ hlog] exact (pairNumerator_threshold hs b c).2 theorem pairExponent_lt_log_two_iff {s : ℕ} (hs : 0 < s) (b c : Fin (2 * s) × Fin (2 * s)) : pairExponent b c < Real.log 2 ↔ (c.1.val, c.2.val) ∉ DistanceCounts.highTargets s b.1.val b.2.val := by rw [← log_two_lt_pairExponent_iff hs b c] exact ⟨fun h => not_lt_of_ge h.le, fun h => lt_of_le_of_ne (le_of_not_gt h) (pairExponent_ne_log_two hs b c)⟩ def highTargetBlocks {s : ℕ} (b : Fin (2 * s) × Fin (2 * s)) : Finset (Fin (2 * s) × Fin (2 * s)) := Finset.univ.filter fun c => Real.log 2 < pairExponent b c /-- The cardinal is cast to integers, so the existing degree subtractions are exact. -/ theorem card_highTargetBlocks {s : ℕ} (hs : 0 < s) (b : Fin (2 * s) × Fin (2 * s)) : ((highTargetBlocks b).card : ℤ) = DistanceCounts.coarseDegree s b.1.val b.2.val := by have hcard : (highTargetBlocks b).card = (DistanceCounts.highTargets s b.1.val b.2.val).card := by apply Finset.card_bij (fun c _ => (c.1.val, c.2.val)) · intro c hc exact (log_two_lt_pairExponent_iff hs b c).mp (Finset.mem_filter.mp hc).2 · intro c hc d hd hcd exact Prod.ext (Fin.ext (congrArg Prod.fst hcd)) (Fin.ext (congrArg Prod.snd hcd)) · intro c hc have hbds := (Finset.mem_filter.mp hc).1 have hc₁ : c.1 < 2 * s := Finset.mem_range.mp (Finset.mem_product.mp hbds).1 have hc₂ : c.2 < 2 * s := Finset.mem_range.mp (Finset.mem_product.mp hbds).2 refine ⟨(⟨c.1, hc₁⟩, ⟨c.2, hc₂⟩), ?_, rfl⟩ simp only [highTargetBlocks, Finset.mem_filter, Finset.mem_univ, true_and] exact (log_two_lt_pairExponent_iff hs b _).mpr hc rw [hcard] exact DistanceCounts.card_highTargets hs b.1.isLt b.2.isLt /-- One positive gap works for every ordered pair in the fixed even grid. -/ theorem exists_uniform_exponent_gap {s : ℕ} (hs : 0 < s) : ∃ ε : ℝ, 0 < ε ∧ ∀ b c : Fin (2 * s) × Fin (2 * s), ε ≤ |pairExponent b c - Real.log 2| := by classical let z : Fin (2 * s) := ⟨0, by omega⟩ let F : Finset ((Fin (2 * s) × Fin (2 * s)) × (Fin (2 * s) × Fin (2 * s))) := Finset.univ have hF : F.Nonempty := ⟨((z, z), (z, z)), Finset.mem_univ _⟩ obtain ⟨p, hp, hmin⟩ := F.exists_min_image (fun q => |pairExponent q.1 q.2 - Real.log 2|) hF refine ⟨|pairExponent p.1 p.2 - Real.log 2|, ?_, ?_⟩ · exact abs_pos.mpr (sub_ne_zero.mpr (pairExponent_ne_log_two hs p.1 p.2)) · intro b c exact hmin (b, c) (Finset.mem_univ _) end DistanceCounts.ThresholdWeights end end BodyFile014 -- Source: DistanceCounts/RepresentationCount.lean section BodyFile015 /-! Finite Gaussian norm circles, their unit orbits, and prime-norm reductions. -/ noncomputable section namespace DistanceCounts /-- The actual Gaussian integers on a norm circle, enumerated inside a genuine disk. -/ def normCircle (n : ℕ) : Finset GaussianInt := by classical exact (gaussianDisk 0 (Real.sqrt n)).filter (fun z => z.norm.natAbs = n) lemma gaussian_complex_norm (z : GaussianInt) : ‖(z : ℂ)‖ = Real.sqrt (z.norm.natAbs : ℝ) := by rw [Complex.norm_def, ← GaussianInt.intCast_real_norm] congr 1 simpa only [Int.cast_natCast] using congrArg (fun n : ℤ => (n : ℝ)) (GaussianInt.abs_natCast_norm z).symm lemma mem_normCircle (n : ℕ) (z : GaussianInt) : z ∈ normCircle n ↔ z.norm.natAbs = n := by classical constructor · exact fun hz => (Finset.mem_filter.mp hz).2 · intro hz apply Finset.mem_filter.mpr refine ⟨(mem_gaussianDisk _ _ _).mpr ?_, hz⟩ simp only [dist_zero_right, gaussian_complex_norm, hz, le_refl] lemma mem_normCircle_iff_norm (n : ℕ) (z : GaussianInt) : z ∈ normCircle n ↔ z.norm = (n : ℤ) := by rw [mem_normCircle, ← Int.natCast_inj, GaussianInt.abs_natCast_norm] lemma self_mem_normCircle (z : GaussianInt) : z ∈ normCircle z.norm.natAbs := (mem_normCircle _ _).mpr rfl lemma normCircle_zero : normCircle 0 = {0} := by classical ext z simp [mem_normCircle_iff_norm, GaussianInt.norm_eq_zero] lemma normCircle_zero_card : (normCircle 0).card = 1 := by rw [normCircle_zero, Finset.card_singleton] lemma ne_zero_of_mem_normCircle {n : ℕ} (hn : n ≠ 0) {z : GaussianInt} (hz : z ∈ normCircle n) : z ≠ 0 := by intro h subst z have := (mem_normCircle n 0).mp hz exact hn (by simpa using this.symm) /-- This transfers the existing sum-of-two-squares theorem to the finite circle, including its special convention at zero. -/ lemma normCircle_nonempty_iff_sum_two_squares (n : ℕ) : (normCircle n).Nonempty ↔ ∃ a b : ℕ, n = a ^ 2 + b ^ 2 := by constructor · rintro ⟨z, hz⟩ refine ⟨z.re.natAbs, z.im.natAbs, ?_⟩ rw [← (mem_normCircle _ _).mp hz, GaussianInt.natAbs_norm_eq] ring · rintro ⟨a, b, hab⟩ refine ⟨⟨a, b⟩, (mem_normCircle _ _).mpr ?_⟩ simpa [GaussianInt.natAbs_norm_eq, pow_two] using hab.symm lemma normCircle_nonempty_iff (n : ℕ) : (normCircle n).Nonempty ↔ ∀ q ∈ n.primeFactors, q % 4 = 3 → Even (padicValNat q n) := by rw [normCircle_nonempty_iff_sum_two_squares, Nat.eq_sq_add_sq_iff] /-- There are exactly four norm-one elements; no quotient or unit multiplicity is silently discarded. -/ lemma normCircle_one : normCircle 1 = {⟨1, 0⟩, ⟨-1, 0⟩, ⟨0, 1⟩, ⟨0, -1⟩} := by classical ext z rcases z with ⟨a, b⟩ constructor · intro hz have h : a * a + b * b = 1 := by simpa [Zsqrtd.norm] using (mem_normCircle_iff_norm 1 ⟨a, b⟩).mp hz have ha : -1 ≤ a ∧ a ≤ 1 := by constructor <;> nlinarith [sq_nonneg b] have hb : -1 ≤ b ∧ b ≤ 1 := by constructor <;> nlinarith [sq_nonneg a] rcases ha with ⟨ha0, ha1⟩ rcases hb with ⟨hb0, hb1⟩ interval_cases a <;> interval_cases b <;> norm_num at * · intro hz simp only [Finset.mem_insert, Finset.mem_singleton] at hz rcases hz with hz | hz | hz | hz <;> cases hz <;> apply (mem_normCircle_iff_norm _ _).mpr <;> norm_num [Zsqrtd.norm] lemma normCircle_one_card : (normCircle 1).card = 4 := by classical rw [normCircle_one] norm_num [Zsqrtd.ext_iff] /-- The ramified prime has one associate class, hence four rather than eight representations. -/ lemma normCircle_two : normCircle 2 = {⟨1, 1⟩, ⟨1, -1⟩, ⟨-1, 1⟩, ⟨-1, -1⟩} := by classical ext z rcases z with ⟨a, b⟩ constructor · intro hz have h : a * a + b * b = 2 := by simpa [Zsqrtd.norm] using (mem_normCircle_iff_norm 2 ⟨a, b⟩).mp hz have ha : -1 ≤ a ∧ a ≤ 1 := by constructor <;> nlinarith [sq_nonneg b] have hb : -1 ≤ b ∧ b ≤ 1 := by constructor <;> nlinarith [sq_nonneg a] rcases ha with ⟨ha0, ha1⟩ rcases hb with ⟨hb0, hb1⟩ interval_cases a <;> interval_cases b <;> norm_num at * · intro hz simp only [Finset.mem_insert, Finset.mem_singleton] at hz rcases hz with hz | hz | hz | hz <;> cases hz <;> apply (mem_normCircle_iff_norm _ _).mpr <;> norm_num [Zsqrtd.norm] lemma normCircle_two_card : (normCircle 2).card = 4 := by classical rw [normCircle_two] norm_num [Zsqrtd.ext_iff] lemma mem_normCircle_one_iff (z : GaussianInt) : z ∈ normCircle 1 ↔ IsUnit z := by rw [mem_normCircle, Zsqrtd.norm_eq_one_iff] /-- All four associates of an element, represented as actual Gaussian integers. -/ def normUnitOrbit (z : GaussianInt) : Finset GaussianInt := by classical exact (normCircle 1).image (fun u => z * u) lemma mem_normUnitOrbit (z w : GaussianInt) : w ∈ normUnitOrbit z ↔ Associated z w := by classical constructor · intro hw obtain ⟨u, hu, rfl⟩ := Finset.mem_image.mp hw exact associated_mul_unit_right z u ((mem_normCircle_one_iff u).mp hu) · rintro ⟨u, hu⟩ exact Finset.mem_image.mpr ⟨u, (mem_normCircle_one_iff _).mpr u.isUnit, hu⟩ lemma normUnitOrbit_card {z : GaussianInt} (hz : z ≠ 0) : (normUnitOrbit z).card = 4 := by classical rw [normUnitOrbit, Finset.card_image_of_injective _ (fun _ _ h => mul_left_cancel₀ hz h), normCircle_one_card] lemma normUnitOrbit_subset (z : GaussianInt) : normUnitOrbit z ⊆ normCircle z.norm.natAbs := by intro w hw apply (mem_normCircle _ _).mpr exact congrArg Int.natAbs (Zsqrtd.norm_eq_of_associated (by norm_num) ((mem_normUnitOrbit z w).mp hw)).symm lemma four_le_normCircle_card {z : GaussianInt} (hz : z ≠ 0) : 4 ≤ (normCircle z.norm.natAbs).card := by rw [← normUnitOrbit_card hz] exact Finset.card_le_card (normUnitOrbit_subset z) /-- The finite set of associate classes represented on the circle. -/ def normCircleClasses (n : ℕ) : Finset (Associates GaussianInt) := by classical exact (normCircle n).image Associates.mk open scoped Classical in lemma normCircle_associate_fiber {n : ℕ} {z : GaussianInt} (hz : z ∈ normCircle n) : (normCircle n).filter (fun w => Associates.mk w = Associates.mk z) = normUnitOrbit z := by classical ext w rw [Finset.mem_filter, Associates.mk_eq_mk_iff_associated, mem_normUnitOrbit] constructor · exact fun h => h.2.symm · intro h refine ⟨?_, h.symm⟩ rw [mem_normCircle_iff_norm] at hz ⊢ exact (Zsqrtd.norm_eq_of_associated (by norm_num) h).symm.trans hz /-- Exact unit multiplicity, valid also for nonrepresented positive integers. -/ theorem normCircle_card_eq_four_mul_classes (n : ℕ) (hn : n ≠ 0) : (normCircle n).card = 4 * (normCircleClasses n).card := by classical rw [Finset.card_eq_sum_card_image Associates.mk (normCircle n)] have hf : ∀ a ∈ (normCircle n).image Associates.mk, ((normCircle n).filter (fun w => Associates.mk w = a)).card = 4 := by intro a ha obtain ⟨z, hz, rfl⟩ := Finset.mem_image.mp ha rw [normCircle_associate_fiber hz] exact normUnitOrbit_card (ne_zero_of_mem_normCircle hn hz) rw [Finset.sum_congr rfl hf] simp [normCircleClasses, mul_comm] lemma four_dvd_normCircle_card (n : ℕ) (hn : n ≠ 0) : 4 ∣ (normCircle n).card := by rw [normCircle_card_eq_four_mul_classes n hn] exact dvd_mul_right _ _ /-- Multiplication by a nonzero Gaussian integer embeds every smaller norm circle. -/ lemma normCircle_mul_image_subset (a : GaussianInt) (n : ℕ) : (normCircle n).image (fun w => a * w) ⊆ normCircle (a.norm.natAbs * n) := by classical intro z hz obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz rw [mem_normCircle, Zsqrtd.norm_mul, Int.natAbs_mul, (mem_normCircle _ _).mp hw] lemma normCircle_card_le_mul (a : GaussianInt) (ha : a ≠ 0) (n : ℕ) : (normCircle n).card ≤ (normCircle (a.norm.natAbs * n)).card := by classical calc (normCircle n).card = ((normCircle n).image (fun w => a * w)).card := (Finset.card_image_of_injective _ (fun _ _ h => mul_left_cancel₀ ha h)).symm _ ≤ _ := Finset.card_le_card (normCircle_mul_image_subset a n) /-- A Gaussian element of rational prime norm is genuinely a Gaussian prime. -/ lemma gaussian_prime_of_prime_norm {z : GaussianInt} {p : ℕ} (hp : p.Prime) (hz : z.norm.natAbs = p) : Prime z := by apply irreducible_iff_prime.mp constructor · intro hu have := (Zsqrtd.norm_eq_one_iff.mpr hu).symm.trans hz exact hp.ne_one this.symm · intro a b hab have hnorm : p = a.norm.natAbs * b.norm.natAbs := by rw [← hz, hab, Zsqrtd.norm_mul, Int.natAbs_mul] rcases hp.isUnit_or_isUnit hnorm with ha | hb · exact Or.inl (Zsqrtd.norm_eq_one_iff.mp (Nat.isUnit_iff.mp ha)) · exact Or.inr (Zsqrtd.norm_eq_one_iff.mp (Nat.isUnit_iff.mp hb)) /-- Every representation of a prime norm lies in one of the two conjugate associate classes. This is a UFD consequence, not a counting assumption. -/ lemma normCircle_prime_eq_orbits {p : ℕ} (hp : p.Prime) {z : GaussianInt} (hz : z.norm.natAbs = p) : normCircle p = normUnitOrbit z ∪ normUnitOrbit (star z) := by classical ext w rw [Finset.mem_union, mem_normUnitOrbit, mem_normUnitOrbit] constructor · intro hw have hw' := (mem_normCircle _ _).mp hw have hwp := gaussian_prime_of_prime_norm hp hw' have hzp := gaussian_prime_of_prime_norm hp hz have hcp := gaussian_prime_of_prime_norm hp (show (star z).norm.natAbs = p by simpa using hz) have he : (w.norm : GaussianInt) = (z.norm : GaussianInt) := by have he' : w.norm = z.norm := by rw [← GaussianInt.abs_natCast_norm w, ← GaussianInt.abs_natCast_norm z, hw', hz] rw [he'] have hd : w ∣ z * star z := by rw [← Zsqrtd.norm_eq_mul_conj, ← he, Zsqrtd.norm_eq_mul_conj] exact dvd_mul_right _ _ rcases hwp.dvd_or_dvd hd with hd | hd · exact Or.inl (hwp.associated_of_dvd hzp hd).symm · exact Or.inr (hwp.associated_of_dvd hcp hd).symm · intro hw apply (mem_normCircle _ _).mpr rcases hw with hw | hw · exact (congrArg Int.natAbs (Zsqrtd.norm_eq_of_associated (by norm_num) hw)).symm.trans hz · simpa using (congrArg Int.natAbs (Zsqrtd.norm_eq_of_associated (by norm_num) hw)).symm.trans (show (star z).norm.natAbs = p by simpa using hz) lemma normCircle_prime_card_le_eight {p : ℕ} (hp : p.Prime) : (normCircle p).card ≤ 8 := by classical by_cases h : (normCircle p).Nonempty · obtain ⟨z, hz⟩ := h have hz0 := ne_zero_of_mem_normCircle hp.ne_zero hz rw [normCircle_prime_eq_orbits hp ((mem_normCircle _ _).mp hz)] calc _ ≤ (normUnitOrbit z).card + (normUnitOrbit (star z)).card := Finset.card_union_le _ _ _ = 8 := by rw [normUnitOrbit_card hz0, normUnitOrbit_card (by simpa using hz0)] · rw [Finset.not_nonempty_iff_eq_empty.mp h, Finset.card_empty] exact Nat.zero_le _ lemma prime_norm_re_ne_zero {p : ℕ} (hp : p.Prime) {z : GaussianInt} (hz : z.norm.natAbs = p) : z.re ≠ 0 := by intro hre apply hp.prime.not_isSquare refine ⟨z.im.natAbs, ?_⟩ simpa [GaussianInt.natAbs_norm_eq, hre] using hz.symm lemma prime_norm_im_ne_zero {p : ℕ} (hp : p.Prime) {z : GaussianInt} (hz : z.norm.natAbs = p) : z.im ≠ 0 := by intro him apply hp.prime.not_isSquare refine ⟨z.re.natAbs, ?_⟩ simpa [GaussianInt.natAbs_norm_eq, him] using hz.symm /-- At a split rational prime the two conjugate Gaussian prime classes are distinct. The four units are checked explicitly, including the axis cases. -/ lemma not_associated_conj_of_split_prime_norm {p : ℕ} (hp : p.Prime) (hp4 : p % 4 = 1) {z : GaussianInt} (hz : z.norm.natAbs = p) : ¬Associated z (star z) := by rintro ⟨u, hu⟩ have hunit := (mem_normCircle_one_iff (u : GaussianInt)).mpr u.isUnit rw [normCircle_one] at hunit simp only [Finset.mem_insert, Finset.mem_singleton] at hunit have hnorm : z.re * z.re + z.im * z.im = (p : ℤ) := by have h := (mem_normCircle_iff_norm p z).mp ((mem_normCircle p z).mpr hz) simpa [Zsqrtd.norm] using h have hp4' : (p : ℤ) % 4 = 1 := by exact_mod_cast hp4 rcases hunit with hunit | hunit | hunit | hunit · have him := congrArg Zsqrtd.im hu simp [hunit] at him exact prime_norm_im_ne_zero hp hz (by omega) · have hre := congrArg Zsqrtd.re hu simp [hunit] at hre exact prime_norm_re_ne_zero hp hz (by omega) · have hre := congrArg Zsqrtd.re hu simp [hunit] at hre have him : z.im = -z.re := by omega rw [him] at hnorm have heven : (p : ℤ) = 2 * (z.re * z.re) := by nlinarith [hnorm] omega · have hre := congrArg Zsqrtd.re hu simp [hunit] at hre have him : z.im = z.re := by omega rw [him] at hnorm have heven : (p : ℤ) = 2 * (z.re * z.re) := by nlinarith [hnorm] omega lemma normUnitOrbit_disjoint {z w : GaussianInt} (h : ¬Associated z w) : Disjoint (normUnitOrbit z) (normUnitOrbit w) := by classical apply Finset.disjoint_left.mpr intro a hza hwa exact h (((mem_normUnitOrbit z a).mp hza).trans ((mem_normUnitOrbit w a).mp hwa).symm) /-- The first nontrivial representation count: a split prime has exactly eight signed, ordered Gaussian representations. -/ theorem normCircle_split_prime_card {p : ℕ} (hp : p.Prime) (hp4 : p % 4 = 1) : (normCircle p).card = 8 := by classical obtain ⟨a, b, hab⟩ := @Nat.Prime.sq_add_sq p ⟨hp⟩ (by omega) obtain ⟨z, hz⟩ := (normCircle_nonempty_iff_sum_two_squares p).mpr ⟨a, b, hab.symm⟩ have hz' := (mem_normCircle _ _).mp hz have hz0 := ne_zero_of_mem_normCircle hp.ne_zero hz rw [normCircle_prime_eq_orbits hp hz', Finset.card_union_of_disjoint (normUnitOrbit_disjoint (not_associated_conj_of_split_prime_norm hp hp4 hz')), normUnitOrbit_card hz0, normUnitOrbit_card (by simpa using hz0)] /-- Removing an inert rational prime from both coordinates is an exact bijection of norm circles, even when the residual norm is zero. -/ theorem normCircle_inert_square (p n : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) : normCircle (p * p * n) = (normCircle n).image (fun w => (p : GaussianInt) * w) := by classical ext z constructor · intro hz have hz' := (mem_normCircle _ _).mp hz have hpd : p ∣ z.norm.natAbs := by rw [hz'] exact ⟨p * n, by ring⟩ obtain ⟨w, rfl⟩ := (GaussianNorm.inert_dvd_natNorm_iff p hp hp3 z).mp hpd refine Finset.mem_image.mpr ⟨w, (mem_normCircle _ _).mpr ?_, rfl⟩ have hmul : (p * p) * w.norm.natAbs = (p * p) * n := by simpa [Zsqrtd.norm_mul, Zsqrtd.norm_natCast, Int.natAbs_mul] using hz' exact mul_left_cancel₀ (mul_ne_zero hp.ne_zero hp.ne_zero) hmul · intro hz obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz apply (mem_normCircle _ _).mpr simp [Zsqrtd.norm_mul, Zsqrtd.norm_natCast, Int.natAbs_mul, (mem_normCircle _ _).mp hw] theorem normCircle_inert_square_card (p n : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) : (normCircle (p * p * n)).card = (normCircle n).card := by classical rw [normCircle_inert_square p n hp hp3] apply Finset.card_image_of_injective have hp0 : (p : GaussianInt) ≠ 0 := by exact_mod_cast hp.ne_zero exact fun _ _ h => mul_left_cancel₀ hp0 h /-- An inert prime norm has no representations. -/ lemma normCircle_inert_prime (p : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) : normCircle p = ∅ := by classical apply Finset.eq_empty_iff_forall_notMem.mpr intro z hz have hz' := (mem_normCircle _ _).mp hz have hd : (p : GaussianInt) ∣ z := (GaussianNorm.inert_dvd_natNorm_iff p hp hp3 z).mp (by rw [hz']) obtain ⟨w, rfl⟩ := hd have he : (p * p) * w.norm.natAbs = p := by simpa [Zsqrtd.norm_mul, Zsqrtd.norm_natCast, Int.natAbs_mul] using hz' have hw : w.norm.natAbs ≠ 0 := by intro hw rw [hw, mul_zero] at he exact hp.ne_zero he.symm have hp2 := hp.two_le have hw1 := Nat.one_le_iff_ne_zero.mpr hw nlinarith /-- Exact prime-step decomposition before counting overlaps. Unlike the prime-norm case, the two images can overlap when `p` divides `n`. -/ theorem normCircle_prime_mul (p n : ℕ) (hp : p.Prime) {z : GaussianInt} (hz : z.norm.natAbs = p) : normCircle (p * n) = (normCircle n).image (fun v => z * v) ∪ (normCircle n).image (fun v => star z * v) := by classical have hzp := gaussian_prime_of_prime_norm hp hz have hzc : (star z).norm.natAbs = p := by simpa using hz have hzn : z.norm = (p : ℤ) := (mem_normCircle_iff_norm _ _).mp ((mem_normCircle _ _).mpr hz) have hpcast : (p : GaussianInt) = z * star z := by rw [← Zsqrtd.norm_eq_mul_conj, hzn] simp ext w constructor · intro hw have hwn := (mem_normCircle_iff_norm _ _).mp hw have hwn' := (mem_normCircle _ _).mp hw have hd : z ∣ w * star w := by rw [← Zsqrtd.norm_eq_mul_conj, hwn, Int.cast_natCast, Nat.cast_mul, hpcast] exact dvd_mul_of_dvd_left (dvd_mul_right z (star z)) _ have hdiv : z ∣ w ∨ star z ∣ w := by rcases hzp.dvd_or_dvd hd with hd | hd · exact Or.inl hd · right obtain ⟨v, hv⟩ := hd exact ⟨star v, by simpa using congrArg star hv⟩ apply Finset.mem_union.mpr rcases hdiv with ⟨v, rfl⟩ | ⟨v, rfl⟩ · left apply Finset.mem_image.mpr refine ⟨v, (mem_normCircle _ _).mpr ?_, rfl⟩ have hmul : p * v.norm.natAbs = p * n := by simpa [Zsqrtd.norm_mul, Int.natAbs_mul, hz] using hwn' exact mul_left_cancel₀ hp.ne_zero hmul · right apply Finset.mem_image.mpr refine ⟨v, (mem_normCircle _ _).mpr ?_, rfl⟩ have hmul : p * v.norm.natAbs = p * n := by simpa [Zsqrtd.norm_mul, Int.natAbs_mul, hzc, hz] using hwn' exact mul_left_cancel₀ hp.ne_zero hmul · intro hw rcases Finset.mem_union.mp hw with hw | hw · simpa [hz] using normCircle_mul_image_subset z n hw · simpa [hzc, hz] using normCircle_mul_image_subset (star z) n hw end DistanceCounts end end BodyFile015 -- Source: DistanceCounts/GaussianDivisibility.lean section BodyFile016 /-! Actual Gaussian divisibility populations and their first two split-prime moments. -/ noncomputable section namespace DistanceCounts.GaussianDivisibility /-- Squared covolume of multiplication by a Gaussian integer. -/ def normMass (d : GaussianInt) : ℝ := d.norm.natAbs lemma normMass_mul (a b : GaussianInt) : normMass (a * b) = normMass a * normMass b := by simp [normMass, Zsqrtd.norm_mul, Int.natAbs_mul] lemma normMass_star (d : GaussianInt) : normMass (star d) = normMass d := by simp [normMass] lemma normMass_natCast (n : ℕ) : normMass (n : GaussianInt) = (n : ℝ) ^ 2 := by simp [normMass, Zsqrtd.norm_natCast, pow_two] lemma normMass_eq_sq_norm (d : GaussianInt) : normMass d = ‖(d : ℂ)‖ ^ 2 := by rw [gaussian_complex_norm, Real.sq_sqrt (Nat.cast_nonneg _)] rfl lemma one_le_normMass {d : GaussianInt} (hd : d ≠ 0) : 1 ≤ normMass d := by have h : 0 < d.norm.natAbs := Int.natAbs_pos.mpr (GaussianInt.norm_eq_zero.not.mpr hd) change (1 : ℝ) ≤ (d.norm.natAbs : ℝ) exact_mod_cast Nat.succ_le_of_lt h lemma one_le_complex_norm {d : GaussianInt} (hd : d ≠ 0) : 1 ≤ ‖(d : ℂ)‖ := by have h := one_le_normMass hd rw [normMass_eq_sq_norm] at h nlinarith [norm_nonneg (d : ℂ)] /-- The filtered disk, including zero, of multiples of `d`. -/ def divisorDisk (d : GaussianInt) (R : ℝ) : Finset GaussianInt := by classical exact (gaussianDisk 0 R).filter (fun z => d ∣ z) /-- The actual norm-divisibility event, not independent surrogate variables. -/ def primeDisk (p : ℕ) (R : ℝ) : Finset GaussianInt := by classical exact (gaussianDisk 0 R).filter (fun z => p ∣ z.norm.natAbs) lemma mem_divisorDisk (d z : GaussianInt) (R : ℝ) : z ∈ divisorDisk d R ↔ dist (z : ℂ) 0 ≤ R ∧ d ∣ z := by classical simp [divisorDisk, mem_gaussianDisk] lemma mem_primeDisk (p : ℕ) (z : GaussianInt) (R : ℝ) : z ∈ primeDisk p R ↔ dist (z : ℂ) 0 ≤ R ∧ p ∣ z.norm.natAbs := by classical simp [primeDisk, mem_gaussianDisk] lemma divisorDisk_eq_coset (d : GaussianInt) (hd : d ≠ 0) (R : ℝ) : divisorDisk d R = gaussianCosetDisk 0 d 0 R := by classical ext z rw [mem_divisorDisk, mem_gaussianCosetDisk _ _ _ hd] simp only [zero_add] constructor · rintro ⟨hR, w, hw⟩ exact ⟨⟨w, hw.symm⟩, hR⟩ · rintro ⟨⟨w, hw⟩, hR⟩ exact ⟨hR, w, hw.symm⟩ /-- The sharp scale-sensitive error inherited from the genuine ideal lattice. -/ theorem divisorDisk_card_error_scaled (d : GaussianInt) (hd : d ≠ 0) {R : ℝ} (hR : 0 ≤ R) : |((divisorDisk d R).card : ℝ) - Real.pi * R ^ 2 / normMass d| ≤ (4 * Real.pi) * (R / ‖(d : ℂ)‖ + 1) := by have h := gaussianCosetDisk_card_error 0 d hd 0 hR rw [← divisorDisk_eq_coset d hd R] at h simpa only [normMass_eq_sq_norm, div_pow, mul_div_assoc] using h /-- A single constant works simultaneously for every nonzero Gaussian divisor. -/ theorem divisorDisk_card_error (d : GaussianInt) (hd : d ≠ 0) {R : ℝ} (hR : 0 ≤ R) : |((divisorDisk d R).card : ℝ) - Real.pi * R ^ 2 / normMass d| ≤ (4 * Real.pi) * (R + 1) := by apply (divisorDisk_card_error_scaled d hd hR).trans have hn := one_le_complex_norm hd have hs : R / ‖(d : ℂ)‖ ≤ R := (div_le_iff₀ (by linarith : 0 < ‖(d : ℂ)‖)).mpr (by nlinarith) exact mul_le_mul_of_nonneg_left (show R / ‖(d : ℂ)‖ + 1 ≤ R + 1 by linarith) (by positivity) /-- Once zero is removed the count has no additive error, even for very large divisors. -/ theorem divisorDisk_erase_zero_card_upper (d : GaussianInt) (hd : d ≠ 0) {R : ℝ} (hR : 0 ≤ R) : (((divisorDisk d R).erase 0).card : ℝ) ≤ 9 * Real.pi * R ^ 2 / normMass d := by classical by_cases he : ((divisorDisk d R).erase 0).Nonempty · obtain ⟨w, hw⟩ := he obtain ⟨hw0, hw⟩ := Finset.mem_erase.mp hw obtain ⟨hwr, u, rfl⟩ := (mem_divisorDisk d w R).mp hw have hu : u ≠ 0 := by intro h; simp [h] at hw0 have hn : 0 < ‖(d : ℂ)‖ := by linarith [one_le_complex_norm hd] have hr1 : 1 ≤ R / ‖(d : ℂ)‖ := by have hu1 := one_le_complex_norm hu simp only [dist_zero_right, GaussianInt.toComplex_mul, norm_mul] at hwr apply (le_div_iff₀ hn).mpr nlinarith have hc : (((divisorDisk d R).erase 0).card : ℝ) ≤ ((gaussianDisk 0 (R / ‖(d : ℂ)‖)).card : ℝ) := by have hcard := Finset.card_le_card (Finset.erase_subset (s := divisorDisk d R) 0) have heq : (divisorDisk d R).card = (gaussianDisk 0 (R / ‖(d : ℂ)‖)).card := by rw [divisorDisk_eq_coset d hd, gaussianCosetDisk_card _ _ hd] simp rw [heq] at hcard exact_mod_cast hcard have hupp := gaussianDisk_card_upper 0 (div_nonneg hR (norm_nonneg (d : ℂ))) have hs : (R / ‖(d : ℂ)‖ + 2) ^ 2 ≤ 9 * (R / ‖(d : ℂ)‖) ^ 2 := by nlinarith calc _ ≤ Real.pi * (R / ‖(d : ℂ)‖ + 2) ^ 2 := hc.trans hupp _ ≤ Real.pi * (9 * (R / ‖(d : ℂ)‖) ^ 2) := mul_le_mul_of_nonneg_left hs Real.pi_nonneg _ = _ := by rw [normMass_eq_sq_norm, div_pow]; ring · rw [Finset.not_nonempty_iff_eq_empty.mp he, Finset.card_empty, Nat.cast_zero] exact div_nonneg (by positivity) (by unfold normMass; positivity) lemma exists_split_factor (p : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) : ∃ z : GaussianInt, z.norm.natAbs = p := by obtain ⟨a, b, hab⟩ := @Nat.Prime.sq_add_sq p ⟨hp⟩ (by omega) obtain ⟨z, hz⟩ := (normCircle_nonempty_iff_sum_two_squares p).mpr ⟨a, b, hab.symm⟩ exact ⟨z, (mem_normCircle _ _).mp hz⟩ lemma split_factorization {p : ℕ} {z : GaussianInt} (hz : z.norm.natAbs = p) : (p : GaussianInt) = z * star z := by have hn : z.norm = (p : ℤ) := (mem_normCircle_iff_norm _ _).mp ((mem_normCircle _ _).mpr hz) rw [← Zsqrtd.norm_eq_mul_conj, hn] simp /-- The exact split-prime divisibility disjunction. -/ theorem split_dvd_norm_iff {p : ℕ} (hp : p.Prime) {z : GaussianInt} (hz : z.norm.natAbs = p) (w : GaussianInt) : p ∣ w.norm.natAbs ↔ z ∣ w ∨ star z ∣ w := by have hzp := gaussian_prime_of_prime_norm hp hz constructor · intro h have hc : (p : GaussianInt) ∣ (w.norm : GaussianInt) := by simpa only [Int.cast_natCast] using (Zsqrtd.intCast_dvd_intCast (p : ℤ) w.norm).mpr ((Int.natCast_dvd).mpr h) have hzpc : z ∣ (p : GaussianInt) := by rw [split_factorization hz] exact dvd_mul_right _ _ have hd := dvd_trans hzpc hc rw [Zsqrtd.norm_eq_mul_conj] at hd rcases hzp.dvd_or_dvd hd with hw | hw · exact Or.inl hw · right obtain ⟨u, hu⟩ := hw refine ⟨star u, ?_⟩ simpa [mul_comm] using congrArg star hu · rintro (⟨u, rfl⟩ | ⟨u, rfl⟩) <;> simp [Zsqrtd.norm_mul, Int.natAbs_mul, hz] /-- Both conjugate factors divide exactly the rational-prime multiples. -/ theorem split_factor_inter_iff {p : ℕ} (hp : p.Prime) (hp4 : p % 4 = 1) {z : GaussianInt} (hz : z.norm.natAbs = p) (w : GaussianInt) : z ∣ w ∧ star z ∣ w ↔ (p : GaussianInt) ∣ w := by have hzp := gaussian_prime_of_prime_norm hp hz have hcp := gaussian_prime_of_prime_norm hp (show (star z).norm.natAbs = p by simpa using hz) have hnot : ¬star z ∣ z := by intro h exact not_associated_conj_of_split_prime_norm hp hp4 hz (hcp.associated_of_dvd hzp h).symm rw [split_factorization hz] constructor · rintro ⟨⟨u, rfl⟩, hu⟩ obtain ⟨v, rfl⟩ := (hcp.dvd_or_dvd hu).resolve_left hnot exact ⟨v, by ring⟩ · intro h exact ⟨dvd_trans (dvd_mul_right _ _) h, dvd_trans (dvd_mul_left _ _) h⟩ lemma primeDisk_eq_union {p : ℕ} (hp : p.Prime) {z : GaussianInt} (hz : z.norm.natAbs = p) (R : ℝ) : primeDisk p R = divisorDisk z R ∪ divisorDisk (star z) R := by classical ext w simp only [Finset.mem_union, mem_primeDisk, mem_divisorDisk, split_dvd_norm_iff hp hz] tauto lemma split_divisorDisk_inter {p : ℕ} (hp : p.Prime) (hp4 : p % 4 = 1) {z : GaussianInt} (hz : z.norm.natAbs = p) (R : ℝ) : divisorDisk z R ∩ divisorDisk (star z) R = divisorDisk (p : GaussianInt) R := by classical ext w simp only [Finset.mem_inter, mem_divisorDisk] have h := split_factor_inter_iff hp hp4 hz w tauto lemma divisorDisk_inter (a b : GaussianInt) (hab : IsCoprime a b) (R : ℝ) : divisorDisk a R ∩ divisorDisk b R = divisorDisk (a * b) R := by classical ext w simp only [Finset.mem_inter, mem_divisorDisk] constructor · rintro ⟨⟨hw, ha⟩, _, hb⟩ exact ⟨hw, hab.mul_dvd ha hb⟩ · rintro ⟨hw, h⟩ exact ⟨⟨hw, dvd_trans (dvd_mul_right _ _) h⟩, hw, dvd_trans (dvd_mul_left _ _) h⟩ /-- The three-term inclusion-exclusion estimate, with no probabilistic input. -/ lemma card_union_error (A B : Finset GaussianInt) (a b c E : ℝ) (ha : |(A.card : ℝ) - a| ≤ E) (hb : |(B.card : ℝ) - b| ≤ E) (hc : |((A ∩ B).card : ℝ) - c| ≤ E) : |((A ∪ B).card : ℝ) - (a + b - c)| ≤ 3 * E := by classical have he : ((A ∪ B).card : ℝ) + ((A ∩ B).card : ℝ) = (A.card : ℝ) + (B.card : ℝ) := by exact_mod_cast Finset.card_union_add_card_inter A B obtain ⟨ha₁, ha₂⟩ := abs_le.mp ha obtain ⟨hb₁, hb₂⟩ := abs_le.mp hb obtain ⟨hc₁, hc₂⟩ := abs_le.mp hc apply abs_le.mpr constructor <;> linarith /-- Natural density of the split norm-divisibility event. -/ def splitDensity (p : ℕ) : ℝ := 2 / (p : ℝ) - 1 / (p : ℝ) ^ 2 /-- A divisor coprime to `p` can be imposed without changing the local split density. This is the three-term building block for the genuine nine-term second moment. -/ theorem divisor_primeDisk_card_error (d : GaussianInt) (hd : d ≠ 0) (p : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) (hdp : IsCoprime d (p : GaussianInt)) {R : ℝ} (hR : 0 ≤ R) : |((divisorDisk d R ∩ primeDisk p R).card : ℝ) - Real.pi * R ^ 2 * splitDensity p / normMass d| ≤ (12 * Real.pi) * (R + 1) := by classical obtain ⟨z, hz⟩ := exists_split_factor p hp hp4 have hz0 := (gaussian_prime_of_prime_norm hp hz).ne_zero have hzc0 : star z ≠ 0 := by simpa using hz0 have hp0 : (p : GaussianInt) ≠ 0 := by exact_mod_cast hp.ne_zero have hdz : IsCoprime d z := hdp.of_isCoprime_of_dvd_right (by rw [split_factorization hz]; exact dvd_mul_right _ _) have hdc : IsCoprime d (star z) := hdp.of_isCoprime_of_dvd_right (by rw [split_factorization hz]; exact dvd_mul_left _ _) let A := divisorDisk d R ∩ divisorDisk z R let B := divisorDisk d R ∩ divisorDisk (star z) R have hA : A = divisorDisk (d * z) R := divisorDisk_inter d z hdz R have hB : B = divisorDisk (d * star z) R := divisorDisk_inter d (star z) hdc R have hI : A ∩ B = divisorDisk (d * (p : GaussianInt)) R := by change (divisorDisk d R ∩ divisorDisk z R) ∩ (divisorDisk d R ∩ divisorDisk (star z) R) = _ rw [← Finset.inter_inter_distrib_left, split_divisorDisk_inter hp hp4 hz, divisorDisk_inter d (p : GaussianInt) hdp] have hU : divisorDisk d R ∩ primeDisk p R = A ∪ B := by rw [primeDisk_eq_union hp hz, Finset.inter_union_distrib_left] have eA := divisorDisk_card_error (d * z) (mul_ne_zero hd hz0) hR have eB := divisorDisk_card_error (d * star z) (mul_ne_zero hd hzc0) hR have eI := divisorDisk_card_error (d * (p : GaussianInt)) (mul_ne_zero hd hp0) hR rw [← hA] at eA rw [← hB] at eB rw [← hI] at eI have he := card_union_error A B _ _ _ _ eA eB eI have hm : Real.pi * R ^ 2 / normMass (d * z) + Real.pi * R ^ 2 / normMass (d * star z) - Real.pi * R ^ 2 / normMass (d * (p : GaussianInt)) = Real.pi * R ^ 2 * splitDensity p / normMass d := by have hn : normMass z = (p : ℝ) := by simp [normMass, hz] have hdN : normMass d ≠ 0 := ne_of_gt (lt_of_lt_of_le (by norm_num) (one_le_normMass hd)) have hpR : (p : ℝ) ≠ 0 := by exact_mod_cast hp.ne_zero rw [normMass_mul, normMass_mul, normMass_mul, normMass_star, hn, normMass_natCast] unfold splitDensity field_simp [hdN, hpR] <;> ring rw [hm, ← hU] at he convert he using 1 <;> ring /-- First moment for the actual split-prime norm event, uniformly in the prime. -/ theorem primeDisk_card_error (p : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) {R : ℝ} (hR : 0 ≤ R) : |((primeDisk p R).card : ℝ) - Real.pi * R ^ 2 * splitDensity p| ≤ (12 * Real.pi) * (R + 1) := by have he := divisor_primeDisk_card_error 1 one_ne_zero p hp hp4 isCoprime_one_left hR have hs : divisorDisk 1 R ∩ primeDisk p R = primeDisk p R := by classical ext w simp only [Finset.mem_inter, mem_divisorDisk, mem_primeDisk, one_dvd, and_true] tauto simpa [hs, normMass] using he /-- The two distinct-prime events have the product main term and a universal error. The proof expands their two three-term union identities into nine genuine ideal counts. -/ theorem primeDisk_inter_card_error (p q : ℕ) (hp : p.Prime) (hq : q.Prime) (hp4 : p % 4 = 1) (hq4 : q % 4 = 1) (hpq : p ≠ q) {R : ℝ} (hR : 0 ≤ R) : |((primeDisk p R ∩ primeDisk q R).card : ℝ) - Real.pi * R ^ 2 * splitDensity p * splitDensity q| ≤ (36 * Real.pi) * (R + 1) := by classical obtain ⟨z, hz⟩ := exists_split_factor q hq hq4 have hz0 := (gaussian_prime_of_prime_norm hq hz).ne_zero have hzc0 : star z ≠ 0 := by simpa using hz0 have hq0 : (q : GaussianInt) ≠ 0 := by exact_mod_cast hq.ne_zero have hqp : IsCoprime (q : GaussianInt) (p : GaussianInt) := ((Nat.coprime_primes hq hp).mpr hpq.symm).cast have hzp : IsCoprime z (p : GaussianInt) := hqp.of_isCoprime_of_dvd_left (by rw [split_factorization hz]; exact dvd_mul_right _ _) have hcp : IsCoprime (star z) (p : GaussianInt) := hqp.of_isCoprime_of_dvd_left (by rw [split_factorization hz]; exact dvd_mul_left _ _) let A := divisorDisk z R ∩ primeDisk p R let B := divisorDisk (star z) R ∩ primeDisk p R have hI : A ∩ B = divisorDisk (q : GaussianInt) R ∩ primeDisk p R := by change (divisorDisk z R ∩ primeDisk p R) ∩ (divisorDisk (star z) R ∩ primeDisk p R) = _ rw [Finset.inter_inter_inter_comm, Finset.inter_self, split_divisorDisk_inter hq hq4 hz] have hU : primeDisk p R ∩ primeDisk q R = A ∪ B := by rw [Finset.inter_comm, primeDisk_eq_union hq hz, Finset.union_inter_distrib_right] have eA := divisor_primeDisk_card_error z hz0 p hp hp4 hzp hR have eB := divisor_primeDisk_card_error (star z) hzc0 p hp hp4 hcp hR have eI := divisor_primeDisk_card_error (q : GaussianInt) hq0 p hp hp4 hqp hR rw [← hI] at eI have he := card_union_error A B _ _ _ _ eA eB eI have hm : Real.pi * R ^ 2 * splitDensity p / normMass z + Real.pi * R ^ 2 * splitDensity p / normMass (star z) - Real.pi * R ^ 2 * splitDensity p / normMass (q : GaussianInt) = Real.pi * R ^ 2 * splitDensity p * splitDensity q := by have hn : normMass z = (q : ℝ) := by simp [normMass, hz] have hpR : (p : ℝ) ≠ 0 := by exact_mod_cast hp.ne_zero have hqR : (q : ℝ) ≠ 0 := by exact_mod_cast hq.ne_zero rw [normMass_star, hn, normMass_natCast] unfold splitDensity field_simp [hpR, hqR] <;> ring rw [hm, ← hU] at he convert he using 1 <;> ring /-- Exact population adjustment: zero contributes one to every raw divisibility count. -/ lemma erase_zero_card (S : Finset GaussianInt) (hS : 0 ∈ S) : ((S.erase 0).card : ℝ) = (S.card : ℝ) - 1 := by classical have h := Finset.card_erase_add_one hS have hc : ((S.erase 0).card : ℝ) + 1 = (S.card : ℝ) := by exact_mod_cast h linarith lemma primeDisk_zero_mem (p : ℕ) {R : ℝ} (hR : 0 ≤ R) : 0 ∈ primeDisk p R := by rw [mem_primeDisk] simpa using hR lemma erase_zero_card_error (S : Finset GaussianInt) (hS : 0 ∈ S) (M C R : ℝ) (hR : 0 ≤ R) (he : |(S.card : ℝ) - M| ≤ C * (R + 1)) : |((S.erase 0).card : ℝ) - M| ≤ (C + 1) * (R + 1) := by rw [erase_zero_card S hS] obtain ⟨he₁, he₂⟩ := abs_le.mp he apply abs_le.mpr constructor <;> nlinarith /-- First moment in the nonzero population used for point-weighted normal order. -/ theorem primeDisk_erase_zero_card_error (p : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) {R : ℝ} (hR : 0 ≤ R) : |(((primeDisk p R).erase 0).card : ℝ) - Real.pi * R ^ 2 * splitDensity p| ≤ (12 * Real.pi + 1) * (R + 1) := erase_zero_card_error _ (primeDisk_zero_mem p hR) _ _ _ hR (primeDisk_card_error p hp hp4 hR) /-- Off-diagonal second moment after removing the common zero vector. -/ theorem primeDisk_inter_erase_zero_card_error (p q : ℕ) (hp : p.Prime) (hq : q.Prime) (hp4 : p % 4 = 1) (hq4 : q % 4 = 1) (hpq : p ≠ q) {R : ℝ} (hR : 0 ≤ R) : |(((primeDisk p R ∩ primeDisk q R).erase 0).card : ℝ) - Real.pi * R ^ 2 * splitDensity p * splitDensity q| ≤ (36 * Real.pi + 1) * (R + 1) := by classical exact erase_zero_card_error _ (Finset.mem_inter.mpr ⟨primeDisk_zero_mem p hR, primeDisk_zero_mem q hR⟩) _ _ _ hR (primeDisk_inter_card_error p q hp hq hp4 hq4 hpq hR) end DistanceCounts.GaussianDivisibility end end BodyFile016 -- Source: DistanceCounts/SieveWeights.lean section BodyFile017 /-! Exact finite Boolean-divisor Möbius inversion and optimal Selberg square weights. -/ noncomputable section namespace DistanceCounts.SieveWeights open Finset variable {α : Type*} [DecidableEq α] /-- A finite lower ideal in the Boolean divisor lattice. The prime indices need not be natural numbers; in particular, conjugate Gaussian primes can have the same norm. -/ structure DivisorFamily (α : Type*) [DecidableEq α] where members : Finset (Finset α) nonempty : members.Nonempty lower : ∀ {S T}, T ∈ members → S ⊆ T → S ∈ members variable (F : DivisorFamily α) def norm (n : α → ℝ) (S : Finset α) : ℝ := ∏ p ∈ S, n p def phi (n : α → ℝ) (S : Finset α) : ℝ := ∏ p ∈ S, (n p - 1) def mobius (S : Finset α) : ℝ := (-1) ^ S.card namespace DivisorFamily def mass (n : α → ℝ) : ℝ := ∑ S ∈ F.members, 1 / phi n S def optimalY (n : α → ℝ) (S : Finset α) : ℝ := if S ∈ F.members then mobius S / (phi n S * F.mass n) else 0 def inverse (y : Finset α → ℝ) (S : Finset α) : ℝ := ∑ T ∈ F.members, if S ⊆ T then mobius (T \ S) * y T else 0 def zeta (f : Finset α → ℝ) (R : Finset α) : ℝ := ∑ S ∈ F.members, if R ⊆ S then f S else 0 def weight (n : α → ℝ) (S : Finset α) : ℝ := norm n S * F.inverse (F.optimalY n) S theorem empty_mem : ∅ ∈ F.members := by obtain ⟨T, hT⟩ := F.nonempty exact F.lower hT (empty_subset T) theorem norm_pos (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) (S : Finset α) : 0 < norm n S := by exact prod_pos fun p _ => lt_of_lt_of_le (by norm_num) (hn p) theorem phi_one_le (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) (S : Finset α) : 1 ≤ phi n S := by apply one_le_prod intro p _ linarith [hn p] theorem phi_pos (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) (S : Finset α) : 0 < phi n S := lt_of_lt_of_le zero_lt_one (phi_one_le n hn S) theorem mass_pos (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) : 0 < F.mass n := by exact sum_pos (fun S _ => one_div_pos.mpr (phi_pos n hn S)) F.nonempty theorem mobius_mul_self (S : Finset α) : mobius S * mobius S = 1 := by unfold mobius rw [← mul_pow] norm_num theorem abs_mobius (S : Finset α) : |mobius S| = 1 := by simp [mobius, abs_pow] theorem mobius_sdiff_mul (S T : Finset α) (hST : S ⊆ T) : mobius (T \ S) * mobius S = mobius T := by unfold mobius rw [← pow_add, card_sdiff_add_card_eq_card hST] theorem mobius_sdiff_mul_mobius (S T : Finset α) (hST : S ⊆ T) : mobius (T \ S) * mobius T = mobius S := by rw [← mobius_sdiff_mul S T hST] rw [← mul_assoc, mobius_mul_self, one_mul] theorem sum_mobius_powerset (T : Finset α) : (∑ S ∈ T.powerset, mobius S) = if T = ∅ then 1 else 0 := by have h := congrArg (fun z : ℤ => (z : ℝ)) (Finset.sum_powerset_neg_one_pow_card (x := T)) simpa [mobius] using h /-- Cancellation on a Boolean interval, established by complementation in its top. -/ theorem interval_cancellation (R T : Finset α) (hT : T ∈ F.members) : (∑ S ∈ F.members, if R ⊆ S ∧ S ⊆ T then mobius (T \ S) else 0) = if R = T then 1 else 0 := by by_cases hRT : R ⊆ T · rw [← sum_filter] have hsum : (∑ S ∈ F.members.filter (fun S => R ⊆ S ∧ S ⊆ T), mobius (T \ S)) = ∑ U ∈ (T \ R).powerset, mobius U := by apply sum_bij (fun S _ => T \ S) · intro S hS simp only [mem_filter] at hS rw [mem_powerset] intro p hp simp only [mem_sdiff] at hp ⊢ exact ⟨hp.1, fun hpR => hp.2 (hS.2.1 hpR)⟩ · intro S hS U hU heq simp only [mem_filter] at hS hU apply Finset.ext intro p have hh := Finset.ext_iff.mp heq p simp only [mem_sdiff] at hh have h1 := hS.2.2 have h2 := hU.2.2 simp only [Finset.subset_iff] at h1 h2 aesop · intro U hU have hu : U ⊆ T \ R := mem_powerset.mp hU refine ⟨T \ U, ?_, ?_⟩ · rw [mem_filter] refine ⟨F.lower hT sdiff_subset, ?_, sdiff_subset⟩ intro p hp rw [mem_sdiff] exact ⟨hRT hp, fun hpU => (mem_sdiff.mp (hu hpU)).2 hp⟩ · apply Finset.ext intro p have hsub : U ⊆ T := hu.trans sdiff_subset simp only [Finset.subset_iff] at hsub simp only [mem_sdiff] aesop · intro S _ rfl rw [hsum, sum_mobius_powerset] have he : T \ R = ∅ ↔ R = T := by rw [sdiff_eq_empty_iff_subset] exact ⟨fun h => subset_antisymm hRT h, fun h => h ▸ subset_rfl⟩ simp only [he] · have hne : R ≠ T := fun h => hRT (h ▸ subset_rfl) rw [if_neg hne] apply sum_eq_zero intro S _ have hh : ¬ (R ⊆ S ∧ S ⊆ T) := fun h => hRT (h.1.trans h.2) simp [hh] /-- Finite upper Möbius inversion. No arithmetic-function or ideal axiom is used. -/ theorem zeta_inverse (y : Finset α → ℝ) (R : Finset α) : F.zeta (F.inverse y) R = if R ∈ F.members then y R else 0 := by unfold zeta inverse simp_rw [ite_sum_zero] rw [sum_comm] have hterm : ∀ T ∈ F.members, (∑ S ∈ F.members, if R ⊆ S then (if S ⊆ T then mobius (T \ S) * y T else 0) else 0) = (if R = T then 1 else 0) * y T := by intro T hT rw [← F.interval_cancellation R T hT, sum_mul] apply sum_congr rfl intro S _ by_cases hRS : R ⊆ S <;> by_cases hST : S ⊆ T <;> simp [hRS, hST] rw [sum_congr rfl hterm] by_cases hR : R ∈ F.members · simp [hR] · simp [hR] theorem inverse_off_support (y : Finset α → ℝ) (S : Finset α) (hS : S ∉ F.members) : F.inverse y S = 0 := by unfold inverse apply sum_eq_zero intro T hT have h : ¬ S ⊆ T := fun h => hS (F.lower hT h) simp [h] theorem weight_off_support (n : α → ℝ) (S : Finset α) (hS : S ∉ F.members) : F.weight n S = 0 := by simp [weight, F.inverse_off_support _ _ hS] theorem weight_div_norm (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) (S : Finset α) : F.weight n S / norm n S = F.inverse (F.optimalY n) S := by unfold weight exact mul_div_cancel_left₀ _ (norm_pos n hn S).ne' theorem transform_weight (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) (R : Finset α) : (∑ S ∈ F.members, if R ⊆ S then F.weight n S / norm n S else 0) = F.optimalY n R := by simp_rw [F.weight_div_norm n hn] rw [← zeta, F.zeta_inverse] by_cases hR : R ∈ F.members <;> simp [optimalY, hR] theorem weight_empty (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) : F.weight n ∅ = 1 := by have hG := (F.mass_pos n hn).ne' unfold weight inverse simp only [norm, prod_empty, one_mul, empty_subset, sdiff_empty, if_true] have hterm : ∀ T ∈ F.members, mobius T * F.optimalY n T = (1 / phi n T) / F.mass n := by intro T hT rw [optimalY, if_pos hT] have hp := (phi_pos n hn T).ne' have hm := mobius_mul_self T field_simp nlinarith rw [sum_congr rfl hterm, ← sum_div, ← mass, div_self hG] theorem phi_divisor_sum (n : α → ℝ) (T : Finset α) : (∑ R ∈ T.powerset, phi n R) = norm n T := by simpa [phi, norm] using (Finset.prod_add_one (f := fun p => n p - 1) T).symm theorem phi_common_divisor_sum (n : α → ℝ) (S T : Finset α) (hS : S ∈ F.members) : (∑ R ∈ F.members, if R ⊆ S ∧ R ⊆ T then phi n R else 0) = norm n (S ∩ T) := by rw [← sum_filter] have he : F.members.filter (fun R => R ⊆ S ∧ R ⊆ T) = (S ∩ T).powerset := by ext R simp only [mem_filter, mem_powerset, subset_inter_iff] exact ⟨fun h => h.2, fun h => ⟨F.lower hS h.1, h⟩⟩ rw [he, phi_divisor_sum] theorem norm_union_inter (n : α → ℝ) (S T : Finset α) : norm n (S ∪ T) * norm n (S ∩ T) = norm n S * norm n T := prod_union_inter /-- Boolean version of Mathlib's `mainSum_lambdaSquared_eq_sum_mul_sum_sq`. The two distinct prime ideals above a split prime remain distinct indices. -/ theorem quadratic_diagonal (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) (w : Finset α → ℝ) : (∑ S ∈ F.members, ∑ T ∈ F.members, w S * w T / norm n (S ∪ T)) = ∑ R ∈ F.members, phi n R * (∑ S ∈ F.members, if R ⊆ S then w S / norm n S else 0) ^ 2 := by have hkernel : ∀ S ∈ F.members, ∀ T ∈ F.members, w S * w T / norm n (S ∪ T) = ∑ R ∈ F.members, if R ⊆ S ∧ R ⊆ T then phi n R * (w S / norm n S) * (w T / norm n T) else 0 := by intro S hS T _ have hN := norm_union_inter n S T have h1 := (norm_pos n hn S).ne' have h2 := (norm_pos n hn T).ne' have h3 := (norm_pos n hn (S ∪ T)).ne' calc _ = norm n (S ∩ T) * (w S / norm n S) * (w T / norm n T) := by field_simp nlinarith [congrArg (fun x : ℝ => w S * w T * x) hN] _ = _ := by rw [← F.phi_common_divisor_sum n S T hS, sum_mul, sum_mul] apply sum_congr rfl intro R _ split_ifs <;> simp calc _ = ∑ S ∈ F.members, ∑ T ∈ F.members, ∑ R ∈ F.members, if R ⊆ S ∧ R ⊆ T then phi n R * (w S / norm n S) * (w T / norm n T) else 0 := by apply sum_congr rfl intro S hS exact sum_congr rfl (fun T hT => hkernel S hS T hT) _ = ∑ R ∈ F.members, ∑ S ∈ F.members, ∑ T ∈ F.members, if R ⊆ S ∧ R ⊆ T then phi n R * (w S / norm n S) * (w T / norm n T) else 0 := by rw [eq_comm, sum_comm] apply sum_congr rfl intro S _ exact sum_comm _ = _ := by apply sum_congr rfl intro R _ simp_rw [sq, sum_mul, mul_sum] apply sum_congr rfl intro S _ apply sum_congr rfl intro T _ by_cases hRS : R ⊆ S <;> by_cases hRT : R ⊆ T <;> simp [hRS, hRT, mul_assoc] theorem optimal_diagonal (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) : (∑ R ∈ F.members, phi n R * (F.optimalY n R) ^ 2) = 1 / F.mass n := by have hG := (F.mass_pos n hn).ne' have hterm : ∀ R ∈ F.members, phi n R * (F.optimalY n R) ^ 2 = (1 / phi n R) / F.mass n ^ 2 := by intro R hR rw [optimalY, if_pos hR] have hp := (phi_pos n hn R).ne' have hm := mobius_mul_self R field_simp nlinarith rw [sum_congr rfl hterm, ← sum_div, ← mass] field_simp /-- The exact main term (5d). -/ theorem quadratic_weight (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) : (∑ S ∈ F.members, ∑ T ∈ F.members, F.weight n S * F.weight n T / norm n (S ∪ T)) = 1 / F.mass n := by rw [F.quadratic_diagonal n hn] simp_rw [F.transform_weight n hn] exact F.optimal_diagonal n hn theorem phi_sdiff_mul (n : α → ℝ) (S T : Finset α) (hST : S ⊆ T) : phi n (T \ S) * phi n S = phi n T := prod_sdiff hST /-- Removing a fixed divisor embeds its multiples in the same lower family. -/ theorem complementary_mass_le (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) (S : Finset α) : (∑ T ∈ F.members.filter (fun T => S ⊆ T), 1 / phi n (T \ S)) ≤ F.mass n := by let H := F.members.filter (fun T => S ⊆ T) have hinj : ∀ T ∈ H, ∀ U ∈ H, T \ S = U \ S → T = U := by intro T hT U hU he have ht : S ⊆ T := (mem_filter.mp hT).2 have hu : S ⊆ U := (mem_filter.mp hU).2 have hh := congrArg (fun V : Finset α => V ∪ S) he simpa [sdiff_union_of_subset ht, sdiff_union_of_subset hu] using hh have hsub : H.image (fun T => T \ S) ⊆ F.members := by intro U hU obtain ⟨T, hT, rfl⟩ := mem_image.mp hU exact F.lower (mem_filter.mp hT).1 sdiff_subset calc _ = ∑ U ∈ H.image (fun T => T \ S), 1 / phi n U := (sum_image hinj).symm _ ≤ F.mass n := sum_le_sum_of_subset_of_nonneg hsub (fun U _ _ => (one_div_pos.mpr (phi_pos n hn U)).le) /-- The explicit positive-sum form of the optimal coefficients. -/ theorem weight_formula (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) (S : Finset α) : F.weight n S = norm n S * mobius S / (phi n S * F.mass n) * (∑ T ∈ F.members.filter (fun T => S ⊆ T), 1 / phi n (T \ S)) := by have hG := (F.mass_pos n hn).ne' have hpS := (phi_pos n hn S).ne' unfold weight inverse rw [← sum_filter, mul_sum, mul_sum] apply sum_congr rfl intro T hT obtain ⟨hT, hST⟩ := mem_filter.mp hT rw [optimalY, if_pos hT] have hm := mobius_sdiff_mul_mobius S T hST have hp := phi_sdiff_mul n S T hST have hpT := (phi_pos n hn T).ne' have hpD := (phi_pos n hn (T \ S)).ne' have he : mobius (T \ S) * (mobius T / (phi n T * F.mass n)) = mobius S / (phi n S * F.mass n) * (1 / phi n (T \ S)) := by calc _ = (mobius (T \ S) * mobius T) / (phi n T * F.mass n) := by ring _ = mobius S / (phi n T * F.mass n) := by rw [hm] _ = _ := by rw [← hp] field_simp <;> ring rw [he] ring /-- The first inequality in (5e), with no arithmetic distribution input. -/ theorem abs_weight_le_norm_div_phi (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) (S : Finset α) : |F.weight n S| ≤ norm n S / phi n S := by have hN := norm_pos n hn S have hp := phi_pos n hn S have hG := F.mass_pos n hn have hsum : 0 ≤ ∑ T ∈ F.members.filter (fun T => S ⊆ T), 1 / phi n (T \ S) := sum_nonneg (fun T _ => (one_div_pos.mpr (phi_pos n hn (T \ S))).le) rw [F.weight_formula n hn, abs_mul, abs_div, abs_mul, abs_mobius, abs_of_pos hN, abs_of_pos (mul_pos hp hG), abs_of_nonneg hsum, mul_one] calc _ ≤ norm n S / (phi n S * F.mass n) * F.mass n := mul_le_mul_of_nonneg_left (F.complementary_mass_le n hn S) (div_pos hN (mul_pos hp hG)).le _ = norm n S / phi n S := by field_simp theorem abs_weight_le_norm (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) (S : Finset α) : |F.weight n S| ≤ norm n S := by apply (F.abs_weight_le_norm_div_phi n hn S).trans exact div_le_self (norm_pos n hn S).le (phi_one_le n hn S) /-- Normalization at the unit becomes the linear constraint in diagonal coordinates. -/ theorem mobius_zeta_empty (f : Finset α → ℝ) : (∑ R ∈ F.members, mobius R * F.zeta f R) = f ∅ := by unfold zeta simp_rw [mul_sum] rw [sum_comm] have hterm : ∀ T ∈ F.members, (∑ R ∈ F.members, mobius R * (if R ⊆ T then f T else 0)) = (if T = ∅ then 1 else 0) * f T := by intro T hT have he : F.members.filter (fun R => R ⊆ T) = T.powerset := by ext R simp only [mem_filter, mem_powerset] exact ⟨fun h => h.2, fun h => ⟨F.lower hT h, h⟩⟩ simp_rw [mul_ite, mul_zero] rw [← sum_filter, he, ← sum_mul, sum_mobius_powerset] rw [sum_congr rfl hterm] simp [F.empty_mem] /-- Completing the square proves optimality, not merely the value at a candidate. -/ theorem diagonal_minimal (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) (f : Finset α → ℝ) (hf : ∑ R ∈ F.members, mobius R * f R = 1) : 1 / F.mass n ≤ ∑ R ∈ F.members, phi n R * (f R) ^ 2 := by have hG := (F.mass_pos n hn).ne' have hcross : (∑ R ∈ F.members, phi n R * f R * F.optimalY n R) = 1 / F.mass n := by have he : ∀ R ∈ F.members, phi n R * f R * F.optimalY n R = (mobius R * f R) / F.mass n := by intro R hR rw [optimalY, if_pos hR] have hp := (phi_pos n hn R).ne' field_simp <;> ring rw [sum_congr rfl he, ← sum_div, hf] have hnonneg : 0 ≤ ∑ R ∈ F.members, phi n R * (f R - F.optimalY n R) ^ 2 := sum_nonneg (fun R _ => mul_nonneg (phi_pos n hn R).le (sq_nonneg _)) have hexpand : (∑ R ∈ F.members, phi n R * (f R - F.optimalY n R) ^ 2) = (∑ R ∈ F.members, phi n R * (f R) ^ 2) - 2 * (∑ R ∈ F.members, phi n R * f R * F.optimalY n R) + (∑ R ∈ F.members, phi n R * (F.optimalY n R) ^ 2) := by rw [mul_sum, ← sum_sub_distrib, ← sum_add_distrib] apply sum_congr rfl intro R _ ring rw [hexpand, hcross, F.optimal_diagonal n hn] at hnonneg linarith /-- Every real coefficient vector normalized at the empty divisor has main term at least the exact value achieved by `weight`. -/ theorem quadratic_minimal (n : α → ℝ) (hn : ∀ p, 2 ≤ n p) (w : Finset α → ℝ) (hw : w ∅ = 1) : 1 / F.mass n ≤ ∑ S ∈ F.members, ∑ T ∈ F.members, w S * w T / norm n (S ∪ T) := by rw [F.quadratic_diagonal n hn] apply F.diagonal_minimal n hn simpa [zeta, norm, hw] using F.mobius_zeta_empty (fun S => w S / norm n S) end DivisorFamily end DistanceCounts.SieveWeights end end BodyFile017 -- Source: DistanceCounts/GaussianMass.lean section BodyFile018 /-! Genuine Gaussian associate classes, finite norm balls, and squarefree mass. -/ noncomputable section namespace DistanceCounts.GaussianMass open Finset UniqueFactorizationMonoid open scoped Classical /-- The norm descends to the actual quotient by Gaussian units. Zero is retained in the ambient monoid and explicitly removed from all counting supports. -/ def classNorm : Associates GaussianInt → ℕ := Quotient.lift (fun z : GaussianInt => z.norm.natAbs) (fun _ _ h => congrArg Int.natAbs (Zsqrtd.norm_eq_of_associated (by norm_num) h)) lemma classNorm_mk (z : GaussianInt) : classNorm (Associates.mk z) = z.norm.natAbs := rfl lemma classNorm_zero : classNorm 0 = 0 := by change (0 : GaussianInt).norm.natAbs = 0 simp lemma classNorm_one : classNorm 1 = 1 := by change (1 : GaussianInt).norm.natAbs = 1 simp lemma classNorm_mul (a b : Associates GaussianInt) : classNorm (a * b) = classNorm a * classNorm b := by obtain ⟨z, rfl⟩ := Associates.mk_surjective a obtain ⟨w, rfl⟩ := Associates.mk_surjective b change (z * w).norm.natAbs = z.norm.natAbs * w.norm.natAbs rw [Zsqrtd.norm_mul, Int.natAbs_mul] lemma classNorm_eq_zero (a : Associates GaussianInt) : classNorm a = 0 ↔ a = 0 := by obtain ⟨z, rfl⟩ := Associates.mk_surjective a rw [classNorm_mk, Int.natAbs_eq_zero, GaussianInt.norm_eq_zero, Associates.mk_eq_zero] lemma classNorm_pos (a : Associates GaussianInt) : 0 < classNorm a ↔ a ≠ 0 := by rw [Nat.pos_iff_ne_zero, ne_eq, classNorm_eq_zero] lemma classNorm_eq_one (a : Associates GaussianInt) : classNorm a = 1 ↔ a = 1 := by obtain ⟨z, rfl⟩ := Associates.mk_surjective a rw [classNorm_mk, Zsqrtd.norm_eq_one_iff, Associates.mk_eq_one] lemma classNorm_prime_two_le {p : Associates GaussianInt} (hp : Prime p) : 2 ≤ classNorm p := by have h0 := (classNorm_pos p).mpr hp.ne_zero have h1 : classNorm p ≠ 1 := by intro h apply hp.not_isUnit rw [(classNorm_eq_one p).mp h] exact isUnit_one omega lemma classNorm_le_of_dvd {a b : Associates GaussianInt} (hb : b ≠ 0) (hab : a ∣ b) : classNorm a ≤ classNorm b := by obtain ⟨c, rfl⟩ := hab have hc : c ≠ 0 := fun h => hb (by simp [h]) rw [classNorm_mul] exact Nat.le_mul_of_pos_right _ ((classNorm_pos c).mpr hc) /-- The finite nonzero Gaussian representatives below the norm cutoff. -/ def representatives (D : ℝ) : Finset GaussianInt := by classical exact (gaussianDisk 0 (Real.sqrt D)).erase 0 /-- Principal nonzero classes, with no representative selected. -/ def classBall (D : ℝ) : Finset (Associates GaussianInt) := by classical exact (representatives D).image Associates.mk lemma mem_representatives {D : ℝ} (hD : 0 ≤ D) (z : GaussianInt) : z ∈ representatives D ↔ z ≠ 0 ∧ (z.norm.natAbs : ℝ) ≤ D := by classical rw [representatives, mem_erase, mem_gaussianDisk] simp only [dist_zero_right, gaussian_complex_norm] rw [Real.sqrt_le_sqrt_iff hD] lemma mem_classBall {D : ℝ} (hD : 0 ≤ D) (a : Associates GaussianInt) : a ∈ classBall D ↔ a ≠ 0 ∧ (classNorm a : ℝ) ≤ D := by classical constructor · intro ha obtain ⟨z, hz, rfl⟩ := mem_image.mp ha obtain ⟨hz0, hzD⟩ := (mem_representatives hD z).mp hz exact ⟨Associates.mk_ne_zero.mpr hz0, hzD⟩ · obtain ⟨z, rfl⟩ := Associates.mk_surjective a rintro ⟨hz0, hzD⟩ exact mem_image.mpr ⟨z, (mem_representatives hD z).mpr ⟨Associates.mk_ne_zero.mp hz0, hzD⟩, rfl⟩ lemma representatives_fiber {D : ℝ} (hD : 0 ≤ D) {z : GaussianInt} (hz : z ∈ representatives D) : (representatives D).filter (fun w => Associates.mk w = Associates.mk z) = normUnitOrbit z := by classical obtain ⟨hz0, hzD⟩ := (mem_representatives hD z).mp hz ext w rw [mem_filter, Associates.mk_eq_mk_iff_associated, mem_normUnitOrbit] constructor · exact fun h => h.2.symm · intro h have he : w.norm.natAbs = z.norm.natAbs := (congrArg Int.natAbs (Zsqrtd.norm_eq_of_associated (by norm_num) h)).symm refine ⟨(mem_representatives hD w).mpr ⟨?_, by simpa [he] using hzD⟩, h.symm⟩ intro hw have hn : z.norm.natAbs = 0 := by simpa [hw] using he.symm exact hz0 (GaussianInt.norm_eq_zero.mp (Int.natAbs_eq_zero.mp hn)) /-- Each nonzero class has exactly four representatives in a norm ball. -/ theorem representatives_card {D : ℝ} (hD : 0 ≤ D) : (representatives D).card = 4 * (classBall D).card := by classical rw [card_eq_sum_card_image Associates.mk (representatives D)] have hf : ∀ a ∈ (representatives D).image Associates.mk, ((representatives D).filter (fun w => Associates.mk w = a)).card = 4 := by intro a ha obtain ⟨z, hz, rfl⟩ := mem_image.mp ha rw [representatives_fiber hD hz] exact normUnitOrbit_card ((mem_representatives hD z).mp hz).1 rw [sum_congr rfl hf] simp [classBall, mul_comm] /-- The origin contributes one, and is not a nonzero principal ideal. -/ theorem disk_card_eq_four_mul_classBall_add_one {D : ℝ} (hD : 0 ≤ D) : (gaussianDisk 0 (Real.sqrt D)).card = 4 * (classBall D).card + 1 := by classical have hzero : (0 : GaussianInt) ∈ gaussianDisk 0 (Real.sqrt D) := by rw [mem_gaussianDisk] simpa using Real.sqrt_nonneg D have he := card_erase_add_one hzero change (representatives D).card + 1 = _ at he rw [representatives_card hD] at he exact he.symm theorem classBall_card {D : ℝ} (hD : 0 ≤ D) : (classBall D).card = ((gaussianDisk 0 (Real.sqrt D)).card - 1) / 4 := by rw [disk_card_eq_four_mul_classBall_add_one hD] omega /-- Explicit form of the ideal count in (5b). -/ theorem classBall_card_error {D : ℝ} (hD : 0 ≤ D) : |((classBall D).card : ℝ) - (Real.pi / 4) * D| ≤ (Real.pi + 1) * (Real.sqrt D + 1) := by have hd := gaussianDisk_card_error (0 : ℂ) (Real.sqrt_nonneg D) rw [Real.sq_sqrt hD] at hd have hc : ((gaussianDisk 0 (Real.sqrt D)).card : ℝ) = 4 * ((classBall D).card : ℝ) + 1 := by exact_mod_cast disk_card_eq_four_mul_classBall_add_one hD rw [hc] at hd obtain ⟨hl, hu⟩ := abs_le.mp hd apply abs_le.mpr constructor <;> nlinarith [Real.sqrt_nonneg D] lemma classBall_zero : classBall 0 = ∅ := by classical apply eq_empty_iff_forall_notMem.mpr intro a ha obtain ⟨ha0, haD⟩ := (mem_classBall (by norm_num) a).mp ha have : classNorm a = 0 := by exact_mod_cast (le_antisymm haD (Nat.cast_nonneg _)) exact ha0 ((classNorm_eq_zero a).mp this) /-- The genuine distinct Gaussian prime classes dividing an associate class. -/ def primeSupport (a : Associates GaussianInt) : Finset (Associates GaussianInt) := (normalizedFactors a).toFinset lemma mem_primeSupport {a p : Associates GaussianInt} (ha : a ≠ 0) : p ∈ primeSupport a ↔ Prime p ∧ p ∣ a := by rw [primeSupport, Multiset.mem_toFinset, mem_normalizedFactors_iff ha] lemma prime_of_mem_primeSupport {a p : Associates GaussianInt} (hp : p ∈ primeSupport a) : Prime p := prime_of_normalized_factor p (Multiset.mem_toFinset.mp hp) /-- Squarefree Euler phi; the unit has empty support and phi one. -/ def squarefreePhi (a : Associates GaussianInt) : ℝ := ∏ p ∈ primeSupport a, ((classNorm p : ℝ) - 1) lemma squarefreePhi_one_le (a : Associates GaussianInt) : 1 ≤ squarefreePhi a := by apply one_le_prod intro p hp have h : (2 : ℝ) ≤ classNorm p := by exact_mod_cast classNorm_prime_two_le (prime_of_mem_primeSupport hp) linarith lemma squarefreePhi_pos (a : Associates GaussianInt) : 0 < squarefreePhi a := lt_of_lt_of_le zero_lt_one (squarefreePhi_one_le a) lemma primeSupport_prod {a : Associates GaussianInt} (ha : Squarefree a) : (∏ p ∈ primeSupport a, p) = a := by have hn := (squarefree_iff_nodup_normalizedFactors ha.ne_zero).mp ha have he : (primeSupport a).val = normalizedFactors a := Multiset.dedup_eq_self.mpr hn simp only [Finset.prod, Multiset.map_id'] rw [he] exact associated_iff_eq.mp (prod_normalizedFactors ha.ne_zero) lemma classNorm_prod (S : Finset (Associates GaussianInt)) : classNorm (∏ p ∈ S, p) = ∏ p ∈ S, classNorm p := by classical induction S using Finset.induction_on with | empty => simp [classNorm_one] | @insert p S hp ih => rw [prod_insert hp, prod_insert hp, classNorm_mul, ih] lemma squarefreePhi_le_norm {a : Associates GaussianInt} (ha : Squarefree a) : squarefreePhi a ≤ (classNorm a : ℝ) := by have hn : classNorm a = ∏ p ∈ primeSupport a, classNorm p := by calc classNorm a = classNorm (∏ p ∈ primeSupport a, p) := congrArg classNorm (primeSupport_prod ha).symm _ = _ := classNorm_prod _ unfold squarefreePhi rw [hn, Nat.cast_prod] apply prod_le_prod · intro p hp have h : (2 : ℝ) ≤ classNorm p := by exact_mod_cast classNorm_prime_two_le (prime_of_mem_primeSupport hp) linarith · intro p _ linarith /-- Squarefree support excludes zero even at cutoff zero. -/ def squarefreeBall (D : ℝ) : Finset (Associates GaussianInt) := by classical exact (classBall D).filter Squarefree lemma mem_squarefreeBall {D : ℝ} (hD : 0 ≤ D) (a : Associates GaussianInt) : a ∈ squarefreeBall D ↔ Squarefree a ∧ (classNorm a : ℝ) ≤ D := by classical rw [squarefreeBall, mem_filter, mem_classBall hD] exact ⟨fun h => ⟨h.2, h.1.2⟩, fun h => ⟨⟨h.1.ne_zero, h.2⟩, h.1⟩⟩ def squarefreeMass (D : ℝ) : ℝ := ∑ a ∈ squarefreeBall D, 1 / squarefreePhi a def reciprocalMass (D : ℝ) : ℝ := ∑ a ∈ classBall D, 1 / (classNorm a : ℝ) lemma classBall_mono {D E : ℝ} (hD : 0 ≤ D) (hDE : D ≤ E) : classBall D ⊆ classBall E := by intro a ha obtain ⟨ha0, haD⟩ := (mem_classBall hD a).mp ha exact (mem_classBall (hD.trans hDE) a).mpr ⟨ha0, haD.trans hDE⟩ theorem classBall_card_div_le_reciprocalMass {D : ℝ} (hD : 0 < D) : ((classBall D).card : ℝ) / D ≤ reciprocalMass D := by calc _ = ∑ _a ∈ classBall D, 1 / D := by simp [div_eq_mul_inv] _ ≤ _ := by apply sum_le_sum intro a ha obtain ⟨ha0, haD⟩ := (mem_classBall hD.le a).mp ha have hn : (0 : ℝ) < classNorm a := by exact_mod_cast (classNorm_pos a).mpr ha0 exact one_div_le_one_div_of_le hn haD /-- A finite annulus estimate ready for summation over dyadic annuli. -/ theorem annulus_reciprocal_lower {E D : ℝ} (hE : 0 ≤ E) (hED : E ≤ D) (hD : 0 < D) : ((Real.pi / 4) * (D - E) - (Real.pi + 1) * (Real.sqrt D + Real.sqrt E + 2)) / D ≤ ∑ a ∈ classBall D \ classBall E, 1 / (classNorm a : ℝ) := by classical have hsub := classBall_mono hE hED have hc : (((classBall D \ classBall E).card : ℕ) : ℝ) + ((classBall E).card : ℝ) = ((classBall D).card : ℝ) := by exact_mod_cast card_sdiff_add_card_eq_card hsub have hl := (abs_le.mp (classBall_card_error hD.le)).1 have hu := (abs_le.mp (classBall_card_error hE)).2 have hcount : (Real.pi / 4) * (D - E) - (Real.pi + 1) * (Real.sqrt D + Real.sqrt E + 2) ≤ ((classBall D \ classBall E).card : ℝ) := by nlinarith calc _ ≤ ((classBall D \ classBall E).card : ℝ) / D := div_le_div_of_nonneg_right hcount hD.le _ = ∑ _a ∈ classBall D \ classBall E, 1 / D := by simp [div_eq_mul_inv] _ ≤ _ := by apply sum_le_sum intro a ha obtain ⟨ha0, haD⟩ := (mem_classBall hD.le a).mp (mem_sdiff.mp ha).1 have hn : (0 : ℝ) < classNorm a := by exact_mod_cast (classNorm_pos a).mpr ha0 exact one_div_le_one_div_of_le hn haD /-- The first comparison in the Selberg denominator argument is termwise and uses the actual distinct prime divisors, not their rational norms as indices. -/ theorem squarefree_reciprocal_le_mass (D : ℝ) : (∑ a ∈ squarefreeBall D, 1 / (classNorm a : ℝ)) ≤ squarefreeMass D := by classical apply sum_le_sum intro a ha have hsq := (mem_filter.mp ha).2 exact one_div_le_one_div_of_le (squarefreePhi_pos a) (squarefreePhi_le_norm hsq) lemma squarefree_prime_prod (S : Finset (Associates GaussianInt)) (hS : ∀ p ∈ S, Prime p) : Squarefree (∏ p ∈ S, p) := by classical have hz : (∏ p ∈ S, p) ≠ 0 := prod_ne_zero_iff.mpr (fun p hp => (hS p hp).ne_zero) have hf : normalizedFactors (∏ p ∈ S, p) = S.val := by simpa only [Finset.prod, Multiset.map_id'] using (normalizedFactors_prod_of_prime (m := S.val) hS) rw [squarefree_iff_nodup_normalizedFactors hz, hf] exact S.nodup lemma primeSupport_prime_prod (S : Finset (Associates GaussianInt)) (hS : ∀ p ∈ S, Prime p) : primeSupport (∏ p ∈ S, p) = S := by have hf : normalizedFactors (∏ p ∈ S, p) = S.val := by simpa only [Finset.prod, Multiset.map_id'] using (normalizedFactors_prod_of_prime (m := S.val) hS) simp [primeSupport, hf] lemma primeSupport_injective_squarefree {a b : Associates GaussianInt} (ha : Squarefree a) (hb : Squarefree b) (h : primeSupport a = primeSupport b) : a = b := by calc a = ∏ p ∈ primeSupport a, p := (primeSupport_prod ha).symm _ = ∏ p ∈ primeSupport b, p := by rw [h] _ = b := primeSupport_prod hb lemma primeSupport_subset_norm_le {a : Associates GaussianInt} (ha : Squarefree a) {S : Finset (Associates GaussianInt)} (hS : S ⊆ primeSupport a) : classNorm (∏ p ∈ S, p) ≤ classNorm a := by have hn : classNorm a = ∏ p ∈ primeSupport a, classNorm p := by calc classNorm a = classNorm (∏ p ∈ primeSupport a, p) := congrArg classNorm (primeSupport_prod ha).symm _ = _ := classNorm_prod _ rw [classNorm_prod, hn] apply prod_le_prod_of_subset_of_one_le' hS intro p hp _ exact le_trans (by norm_num) (classNorm_prime_two_le (prime_of_mem_primeSupport hp)) /-- The norm-cutoff lower family consists exactly of the prime supports of the genuine squarefree quotient classes. The prime indices are Gaussian classes, so the two conjugate primes over a split prime are not identified. -/ def normCutoffFamily (D : ℝ) (hD : 1 ≤ D) : SieveWeights.DivisorFamily (Associates GaussianInt) := by classical refine ⟨(squarefreeBall D).image primeSupport, ?_, ?_⟩ · refine ⟨primeSupport 1, mem_image.mpr ⟨1, ?_, rfl⟩⟩ apply (mem_squarefreeBall (by linarith) 1).mpr exact ⟨squarefree_one, by simpa [classNorm_one] using hD⟩ · intro S T hT hST obtain ⟨a, ha, rfl⟩ := mem_image.mp hT obtain ⟨haSq, haD⟩ := (mem_squarefreeBall (by linarith) a).mp ha have hprime : ∀ p ∈ S, Prime p := fun p hp => prime_of_mem_primeSupport (hST hp) refine mem_image.mpr ⟨∏ p ∈ S, p, ?_, primeSupport_prime_prod S hprime⟩ apply (mem_squarefreeBall (by linarith) _).mpr refine ⟨squarefree_prime_prod S hprime, ?_⟩ have hn : (classNorm (∏ p ∈ S, p) : ℝ) ≤ classNorm a := by exact_mod_cast primeSupport_subset_norm_le haSq hST exact hn.trans haD /-- Exact identification with the finite denominator used by the Selberg weights, independent of any as-yet-unproved growth estimate. -/ theorem normCutoffFamily_mass (D : ℝ) (hD : 1 ≤ D) : (normCutoffFamily D hD).mass (fun p => (classNorm p : ℝ)) = squarefreeMass D := by classical unfold SieveWeights.DivisorFamily.mass normCutoffFamily rw [sum_image] · rfl · intro a ha b hb hab exact primeSupport_injective_squarefree (mem_filter.mp ha).2 (mem_filter.mp hb).2 hab theorem squarefreeMass_pos {D : ℝ} (hD : 1 ≤ D) : 0 < squarefreeMass D := by have h1 : (1 : Associates GaussianInt) ∈ squarefreeBall D := (mem_squarefreeBall (by linarith) 1).mpr ⟨squarefree_one, by simpa [classNorm_one] using hD⟩ exact sum_pos (fun a _ => one_div_pos.mpr (squarefreePhi_pos a)) ⟨1, h1⟩ end DistanceCounts.GaussianMass end end BodyFile018 -- Source: DistanceCounts/GaussianMoments.lean section BodyFile019 /-! Finite, point-weighted moments on the actual nonzero Gaussian disk. -/ noncomputable section namespace DistanceCounts.GaussianMoments open Finset GaussianDivisibility open scoped BigOperators Classical /-- Number of primes in `T` dividing the norm of the actual vector `z`. -/ def splitOmega (T : Finset ℕ) (z : GaussianInt) : ℕ := (T.filter (fun p => p ∣ z.norm.natAbs)).card /-- The sum of local densities, not an assumed population mean. -/ def center (T : Finset ℕ) : ℝ := ∑ p ∈ T, splitDensity p lemma splitDensity_nonneg_le_one {p : ℕ} (hp : p.Prime) : 0 ≤ splitDensity p ∧ splitDensity p ≤ 1 := by have hp1 : (1 : ℝ) ≤ p := by exact_mod_cast hp.one_lt.le have hp0 : (0 : ℝ) < p := by exact_mod_cast hp.pos have hi0 : 0 ≤ 1 / (p : ℝ) := by positivity have hi1 : 1 / (p : ℝ) ≤ 1 := (div_le_one hp0).mpr hp1 have he : splitDensity p = 1 - (1 - 1 / (p : ℝ)) ^ 2 := by unfold splitDensity field_simp [ne_of_gt hp0] <;> ring rw [he] constructor <;> nlinarith [sq_nonneg (1 - 1 / (p : ℝ)), mul_nonneg hi0 (sub_nonneg.mpr hi1)] lemma center_nonneg_le_card (T : Finset ℕ) (hT : ∀ p ∈ T, p.Prime) : 0 ≤ center T ∧ center T ≤ (T.card : ℝ) := by constructor · exact Finset.sum_nonneg (fun p hp => (splitDensity_nonneg_le_one (hT p hp)).1) · calc center T ≤ ∑ _p ∈ T, (1 : ℝ) := Finset.sum_le_sum (fun p hp => (splitDensity_nonneg_le_one (hT p hp)).2) _ = _ := by simp lemma representatives_sq {R : ℝ} (hR : 0 ≤ R) : GaussianMass.representatives (R ^ 2) = (gaussianDisk 0 R).erase 0 := by simp only [GaussianMass.representatives, Real.sqrt_sq hR] /-- The population term in centering retains its own boundary error. -/ theorem population_card_error {R : ℝ} (hR : 0 ≤ R) : |((GaussianMass.representatives (R ^ 2)).card : ℝ) - Real.pi * R ^ 2| ≤ (4 * Real.pi + 1) * (R + 1) := by rw [representatives_sq hR] apply erase_zero_card_error _ _ _ _ _ hR (gaussianDisk_card_error 0 hR) simpa only [mem_gaussianDisk, GaussianInt.toComplex_zero, dist_self] using hR private def indicator (p : ℕ) (z : GaussianInt) : ℝ := if p ∣ z.norm.natAbs then 1 else 0 private lemma splitOmega_cast (T : Finset ℕ) (z : GaussianInt) : (splitOmega T z : ℝ) = ∑ p ∈ T, indicator p z := by simp [splitOmega, indicator] private lemma indicator_sum (p : ℕ) {R : ℝ} (hR : 0 ≤ R) : (∑ z ∈ GaussianMass.representatives (R ^ 2), indicator p z) = (((primeDisk p R).erase 0).card : ℝ) := by rw [representatives_sq hR] simp only [indicator, Finset.sum_boole] congr 2 ext z simp only [Finset.mem_filter, Finset.mem_erase, primeDisk] tauto private lemma indicator_mul_sum (p q : ℕ) {R : ℝ} (hR : 0 ≤ R) : (∑ z ∈ GaussianMass.representatives (R ^ 2), indicator p z * indicator q z) = (((primeDisk p R ∩ primeDisk q R).erase 0).card : ℝ) := by have hi (z : GaussianInt) : indicator p z * indicator q z = if p ∣ z.norm.natAbs ∧ q ∣ z.norm.natAbs then 1 else 0 := by unfold indicator split_ifs <;> simp_all simp_rw [hi] rw [representatives_sq hR] simp only [Finset.sum_boole] congr 2 ext z simp only [Finset.mem_filter, Finset.mem_erase, Finset.mem_inter, primeDisk] tauto /-- Exact first moment: double-count the genuine divisibility incidences. -/ theorem first_moment_identity (T : Finset ℕ) {R : ℝ} (hR : 0 ≤ R) : (∑ z ∈ GaussianMass.representatives (R ^ 2), (splitOmega T z : ℝ)) = ∑ p ∈ T, (((primeDisk p R).erase 0).card : ℝ) := by simp_rw [splitOmega_cast] rw [Finset.sum_comm] exact Finset.sum_congr rfl (fun p _ => indicator_sum p hR) /-- Area-normalized first moment, including the cost of deleting zero. -/ theorem first_moment_error (T : Finset ℕ) (hT : ∀ p ∈ T, p.Prime ∧ p % 4 = 1) {R : ℝ} (hR : 0 ≤ R) : |(∑ z ∈ GaussianMass.representatives (R ^ 2), (splitOmega T z : ℝ)) - Real.pi * R ^ 2 * center T| ≤ (12 * Real.pi + 1) * (R + 1) * (T.card : ℝ) := by rw [first_moment_identity T hR, center, Finset.mul_sum, ← Finset.sum_sub_distrib] calc _ ≤ ∑ p ∈ T, |(((primeDisk p R).erase 0).card : ℝ) - Real.pi * R ^ 2 * splitDensity p| := Finset.abs_sum_le_sum_abs _ _ _ ≤ ∑ _p ∈ T, (12 * Real.pi + 1) * (R + 1) := Finset.sum_le_sum (fun p hp => primeDisk_erase_zero_card_error p (hT p hp).1 (hT p hp).2 hR) _ = _ := by simp [mul_comm] private lemma centered_pair_identity (p q : ℕ) {R : ℝ} (hR : 0 ≤ R) : (∑ z ∈ GaussianMass.representatives (R ^ 2), (indicator p z - splitDensity p) * (indicator q z - splitDensity q)) = (((primeDisk p R ∩ primeDisk q R).erase 0).card : ℝ) - splitDensity q * (((primeDisk p R).erase 0).card : ℝ) - splitDensity p * (((primeDisk q R).erase 0).card : ℝ) + splitDensity p * splitDensity q * ((GaussianMass.representatives (R ^ 2)).card : ℝ) := by have hi (z : GaussianInt) : (indicator p z - splitDensity p) * (indicator q z - splitDensity q) = indicator p z * indicator q z - splitDensity q * indicator p z - splitDensity p * indicator q z + splitDensity p * splitDensity q := by ring simp_rw [hi, Finset.sum_add_distrib, Finset.sum_sub_distrib] rw [← Finset.mul_sum, ← Finset.mul_sum, indicator_mul_sum p q hR, indicator_sum p hR, indicator_sum q hR] simp only [Finset.sum_const, nsmul_eq_mul] ring /-- Ordered-pair covariance bound. The diagonal is treated by the first moment; only distinct primes use the two-prime lattice estimate. -/ private lemma centered_pair_upper (p q : ℕ) (hp : p.Prime) (hq : q.Prime) (hp4 : p % 4 = 1) (hq4 : q % 4 = 1) {R : ℝ} (hR : 0 ≤ R) : (∑ z ∈ GaussianMass.representatives (R ^ 2), (indicator p z - splitDensity p) * (indicator q z - splitDensity q)) ≤ (if p = q then Real.pi * R ^ 2 * splitDensity p else 0) + (64 * Real.pi + 4) * (R + 1) := by let A := Real.pi * R ^ 2 let E₀ := (4 * Real.pi + 1) * (R + 1) let E₁ := (12 * Real.pi + 1) * (R + 1) let E₂ := (36 * Real.pi + 1) * (R + 1) let cp : ℝ := ((primeDisk p R).erase 0).card let cq : ℝ := ((primeDisk q R).erase 0).card let J : ℝ := ((primeDisk p R ∩ primeDisk q R).erase 0).card let N : ℝ := (GaussianMass.representatives (R ^ 2)).card obtain ⟨hdp0, hdp1⟩ := splitDensity_nonneg_le_one hp obtain ⟨hdq0, hdq1⟩ := splitDensity_nonneg_le_one hq have hA : 0 ≤ A := by dsimp [A]; positivity have hE₀ : 0 ≤ E₀ := by dsimp [E₀]; positivity have hE₁ : 0 ≤ E₁ := by dsimp [E₁]; positivity have hE₁₂ : E₁ ≤ E₂ := by dsimp [E₁, E₂] nlinarith [Real.pi_pos, mul_nonneg Real.pi_nonneg hR] have hcp : A * splitDensity p - E₁ ≤ cp := by have h := (abs_le.mp (primeDisk_erase_zero_card_error p hp hp4 hR)).1 change -E₁ ≤ cp - A * splitDensity p at h linarith have hcq : A * splitDensity q - E₁ ≤ cq := by have h := (abs_le.mp (primeDisk_erase_zero_card_error q hq hq4 hR)).1 change -E₁ ≤ cq - A * splitDensity q at h linarith have hN : N ≤ A + E₀ := by have h := (abs_le.mp (population_card_error hR)).2 change N - A ≤ E₀ at h linarith have hJ : J ≤ A * splitDensity p * splitDensity q + (if p = q then A * splitDensity p else 0) + E₂ := by by_cases hpq : p = q · subst q have h := (abs_le.mp (primeDisk_erase_zero_card_error p hp hp4 hR)).2 have hJcp : J = cp := by simp [J, cp] rw [hJcp, if_pos rfl] change cp - A * splitDensity p ≤ E₁ at h nlinarith [mul_nonneg hA (sq_nonneg (splitDensity p))] · have h := (abs_le.mp (primeDisk_inter_erase_zero_card_error p q hp hq hp4 hq4 hpq hR)).2 change J - A * splitDensity p * splitDensity q ≤ E₂ at h rw [if_neg hpq] linarith have hprod0 := mul_nonneg hdp0 hdq0 have hprod1 : splitDensity p * splitDensity q ≤ 1 := by calc _ ≤ 1 * 1 := mul_le_mul hdp1 hdq1 hdq0 (by norm_num) _ = _ := by ring have hcp' := mul_le_mul_of_nonneg_left hcp hdq0 have hcq' := mul_le_mul_of_nonneg_left hcq hdp0 have hN' := mul_le_mul_of_nonneg_left hN hprod0 have hep := mul_le_mul_of_nonneg_left hdp1 hE₁ have heq := mul_le_mul_of_nonneg_left hdq1 hE₁ have heN := mul_le_mul_of_nonneg_left hprod1 hE₀ rw [centered_pair_identity p q hR] change J - splitDensity q * cp - splitDensity p * cq + splitDensity p * splitDensity q * N ≤ _ calc _ ≤ (if p = q then A * splitDensity p else 0) + E₂ + E₁ * splitDensity q + E₁ * splitDensity p + E₀ * (splitDensity p * splitDensity q) := by nlinarith [hJ, hcp', hcq', hN'] _ ≤ (if p = q then A * splitDensity p else 0) + E₂ + E₁ + E₁ + E₀ := by linarith _ = _ := by dsimp [A, E₀, E₁, E₂]; ring /-- The genuine finite centered second moment, normalized by disk area. No assertion that the density center equals the empirical mean is used. -/ theorem centered_second_moment_upper (T : Finset ℕ) (hT : ∀ p ∈ T, p.Prime ∧ p % 4 = 1) {R : ℝ} (hR : 0 ≤ R) : (∑ z ∈ GaussianMass.representatives (R ^ 2), ((splitOmega T z : ℝ) - center T) ^ 2) ≤ Real.pi * R ^ 2 * center T + (64 * Real.pi + 4) * (R + 1) * (T.card : ℝ) ^ 2 := by have hexpand (z : GaussianInt) : ((splitOmega T z : ℝ) - center T) ^ 2 = ∑ p ∈ T, ∑ q ∈ T, (indicator p z - splitDensity p) * (indicator q z - splitDensity q) := by rw [splitOmega_cast, center, ← Finset.sum_sub_distrib, pow_two, Finset.sum_mul] simp_rw [Finset.mul_sum] calc _ = ∑ z ∈ GaussianMass.representatives (R ^ 2), ∑ p ∈ T, ∑ q ∈ T, (indicator p z - splitDensity p) * (indicator q z - splitDensity q) := Finset.sum_congr rfl (fun z _ => hexpand z) _ = ∑ p ∈ T, ∑ q ∈ T, ∑ z ∈ GaussianMass.representatives (R ^ 2), (indicator p z - splitDensity p) * (indicator q z - splitDensity q) := by rw [Finset.sum_comm] exact Finset.sum_congr rfl (fun p _ => Finset.sum_comm) _ ≤ ∑ p ∈ T, ∑ q ∈ T, ((if p = q then Real.pi * R ^ 2 * splitDensity p else 0) + (64 * Real.pi + 4) * (R + 1)) := by apply Finset.sum_le_sum intro p hp apply Finset.sum_le_sum intro q hq exact centered_pair_upper p q (hT p hp).1 (hT q hq).1 (hT p hp).2 (hT q hq).2 hR _ = _ := by simp only [Finset.sum_add_distrib] have hdiag : (∑ p ∈ T, ∑ q ∈ T, if p = q then Real.pi * R ^ 2 * splitDensity p else 0) = Real.pi * R ^ 2 * center T := by simp [center, ← Finset.mul_sum] rw [hdiag] simp only [Finset.sum_const, nsmul_eq_mul] ring /-- Deterministic Chebyshev inequality on the actual nonzero vector population. -/ theorem exceptional_card_mul_sq_le (T : Finset ℕ) (R : ℝ) {a : ℝ} (ha : 0 < a) : (((GaussianMass.representatives (R ^ 2)).filter (fun z => a ≤ |(splitOmega T z : ℝ) - center T|)).card : ℝ) * a ^ 2 ≤ ∑ z ∈ GaussianMass.representatives (R ^ 2), ((splitOmega T z : ℝ) - center T) ^ 2 := by let S := GaussianMass.representatives (R ^ 2) let E := S.filter (fun z => a ≤ |(splitOmega T z : ℝ) - center T|) change (E.card : ℝ) * a ^ 2 ≤ _ calc _ = ∑ _z ∈ E, a ^ 2 := by simp _ ≤ ∑ z ∈ E, ((splitOmega T z : ℝ) - center T) ^ 2 := by apply Finset.sum_le_sum intro z hz have h := (Finset.mem_filter.mp hz).2 have hs := sq_abs ((splitOmega T z : ℝ) - center T) have hm := mul_nonneg (sub_nonneg.mpr h) (show 0 ≤ |(splitOmega T z : ℝ) - center T| + a by positivity) nlinarith _ ≤ _ := Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _) (fun z _ _ => sq_nonneg _) /-- Exceptional-vector cardinal bound with an explicit universal boundary constant. -/ theorem exceptional_card_upper (T : Finset ℕ) (hT : ∀ p ∈ T, p.Prime ∧ p % 4 = 1) {R : ℝ} (hR : 0 ≤ R) {a : ℝ} (ha : 0 < a) : (((GaussianMass.representatives (R ^ 2)).filter (fun z => a ≤ |(splitOmega T z : ℝ) - center T|)).card : ℝ) ≤ (Real.pi * R ^ 2 * center T + (64 * Real.pi + 4) * (R + 1) * (T.card : ℝ) ^ 2) / a ^ 2 := by apply (le_div_iff₀ (sq_pos_of_pos ha)).mpr exact (exceptional_card_mul_sq_le T R ha).trans (centered_second_moment_upper T hT hR) end DistanceCounts.GaussianMoments end end BodyFile019 -- Source: DistanceCounts/GaussianExcess.lean section BodyFile020 /-! A uniform repeated-factor first moment on the actual nonzero Gaussian disk. -/ noncomputable section namespace DistanceCounts.GaussianExcess open Finset GaussianDivisibility /-- Repeated rational-prime factors of the actual Gaussian norm. -/ def excess (T : Finset ℕ) (z : GaussianInt) : ℕ := ∑ p ∈ T, (z.norm.natAbs.factorization p - 1) /-- Allocate every factor of a split prime power to one of its two Gaussian factors. -/ theorem split_pow_dvd_norm {p : ℕ} (hp : p.Prime) {a : GaussianInt} (ha : a.norm.natAbs = p) (k : ℕ) (z : GaussianInt) (h : p ^ k ∣ z.norm.natAbs) : ∃ j ≤ k, a ^ j * star a ^ (k - j) ∣ z := by induction k generalizing z with | zero => exact ⟨0, le_rfl, by simp⟩ | succ k ih => have hpz : p ∣ z.norm.natAbs := dvd_trans (dvd_pow_self p (by omega)) h rcases (split_dvd_norm_iff hp ha z).mp hpz with ⟨u, rfl⟩ | ⟨u, rfl⟩ · have hu : p ^ k ∣ u.norm.natAbs := by have hh : p * p ^ k ∣ p * u.norm.natAbs := by simpa [pow_succ, Zsqrtd.norm_mul, Int.natAbs_mul, ha, mul_comm] using h exact (Nat.mul_dvd_mul_iff_left hp.pos).mp hh obtain ⟨j, hj, v, hv⟩ := ih u hu refine ⟨j + 1, by omega, v, ?_⟩ rw [hv, show k + 1 - (j + 1) = k - j by omega, pow_succ] ring · have hu : p ^ k ∣ u.norm.natAbs := by have hh : p * p ^ k ∣ p * u.norm.natAbs := by simpa [pow_succ, Zsqrtd.norm_mul, Int.natAbs_mul, ha, mul_comm] using h exact (Nat.mul_dvd_mul_iff_left hp.pos).mp hh obtain ⟨j, hj, v, hv⟩ := ih u hu refine ⟨j, by omega, v, ?_⟩ rw [hv, show k + 1 - j = (k - j) + 1 by omega, pow_succ] ring lemma allocated_norm {p : ℕ} {a : GaussianInt} (ha : a.norm.natAbs = p) {j k : ℕ} (hj : j ≤ k) : (a ^ j * star a ^ (k - j)).norm.natAbs = p ^ k := by have hpow (b : GaussianInt) (m : ℕ) : (b ^ m).norm.natAbs = b.norm.natAbs ^ m := by induction m with | zero => simp | succ m ih => simp [pow_succ, Zsqrtd.norm_mul, Int.natAbs_mul, ih] simp only [Zsqrtd.norm_mul, Int.natAbs_mul, hpow, Zsqrtd.norm_conj, ha] rw [← pow_add, Nat.add_sub_of_le hj] /-- The norm-prime-power event is covered by `k + 1` genuine divisor lattices. -/ theorem pow_event_subset_biUnion {p : ℕ} (hp : p.Prime) {a : GaussianInt} (ha : a.norm.natAbs = p) (k : ℕ) {R : ℝ} (hR : 0 ≤ R) : (GaussianMass.representatives (R ^ 2)).filter (fun z => p ^ k ∣ z.norm.natAbs) ⊆ (range (k + 1)).biUnion (fun j => (divisorDisk (a ^ j * star a ^ (k - j)) R).erase 0) := by classical intro z hz obtain ⟨hz, hdiv⟩ := mem_filter.mp hz have hz' : z ∈ (gaussianDisk 0 R).erase 0 := by simpa [GaussianMass.representatives, Real.sqrt_sq hR] using hz obtain ⟨hz0, hzR⟩ := mem_erase.mp hz' obtain ⟨j, hj, hd⟩ := split_pow_dvd_norm hp ha k z hdiv exact mem_biUnion.mpr ⟨j, mem_range.mpr (by omega), mem_erase.mpr ⟨hz0, mem_filter.mpr ⟨hzR, hd⟩⟩⟩ /-- Uniform higher-divisibility bound, including prime powers larger than the disk. -/ theorem pow_event_card_upper (p : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) (k : ℕ) {R : ℝ} (hR : 0 ≤ R) : (((GaussianMass.representatives (R ^ 2)).filter (fun z => p ^ k ∣ z.norm.natAbs)).card : ℝ) ≤ 9 * Real.pi * R ^ 2 * (k + 1) / (p : ℝ) ^ k := by classical obtain ⟨a, ha⟩ := exists_split_factor p hp hp4 have hcard := (card_le_card (pow_event_subset_biUnion hp ha k hR)).trans card_biUnion_le have hc : (((GaussianMass.representatives (R ^ 2)).filter (fun z => p ^ k ∣ z.norm.natAbs)).card : ℝ) ≤ ∑ j ∈ range (k + 1), (((divisorDisk (a ^ j * star a ^ (k - j)) R).erase 0).card : ℝ) := by exact_mod_cast hcard calc _ ≤ ∑ j ∈ range (k + 1), (((divisorDisk (a ^ j * star a ^ (k - j)) R).erase 0).card : ℝ) := hc _ ≤ ∑ _j ∈ range (k + 1), 9 * Real.pi * R ^ 2 / (p : ℝ) ^ k := by apply sum_le_sum intro j hj have hn := allocated_norm ha (Nat.le_of_lt_succ (mem_range.mp hj)) have hd : a ^ j * star a ^ (k - j) ≠ 0 := by intro he have hh : p ^ k = 0 := by simpa [he] using hn.symm exact (pow_ne_zero k hp.ne_zero) hh have he := divisorDisk_erase_zero_card_upper _ hd hR simpa only [normMass, hn, Nat.cast_pow] using he _ = _ := by simp; ring lemma split_prime_five_le {p : ℕ} (hp : p.Prime) (hp4 : p % 4 = 1) : 5 ≤ p := by have := hp.two_le omega /-- An elementary finite geometric-tail bound; no infinite sum interchange is needed. -/ lemma power_tail_sum_le (p N : ℕ) (hp : 5 ≤ p) : (∑ k ∈ range N, ((k : ℝ) + 3) / (p : ℝ) ^ (k + 2)) ≤ 6 / (p : ℝ) ^ 2 := by have hpR : (5 : ℝ) ≤ p := by exact_mod_cast hp have hp0 : (0 : ℝ) < p := by linarith have hstep (k : ℕ) : ((k : ℝ) + 3) / (p : ℝ) ^ (k + 2) ≤ 2 * ((k : ℝ) + 3) / (p : ℝ) ^ (k + 2) - 2 * ((k : ℝ) + 4) / (p : ℝ) ^ (k + 3) := by have hratio : 2 * ((k : ℝ) + 4) ≤ ((k : ℝ) + 3) * (p : ℝ) := by nlinarith [Nat.cast_nonneg (α := ℝ) k, mul_nonneg (sub_nonneg.mpr hpR) (show 0 ≤ (k : ℝ) + 3 by positivity)] have hdec : 2 * ((k : ℝ) + 4) / (p : ℝ) ^ (k + 3) ≤ ((k : ℝ) + 3) / (p : ℝ) ^ (k + 2) := by rw [show k + 3 = (k + 2) + 1 by omega, pow_succ, mul_comm ((p : ℝ) ^ (k + 2)) (p : ℝ), ← div_div] exact div_le_div_of_nonneg_right ((div_le_iff₀ hp0).mpr hratio) (by positivity) calc _ ≤ ((k : ℝ) + 3) / (p : ℝ) ^ (k + 2) + (((k : ℝ) + 3) / (p : ℝ) ^ (k + 2) - 2 * ((k : ℝ) + 4) / (p : ℝ) ^ (k + 3)) := le_add_of_nonneg_right (sub_nonneg.mpr hdec) _ = _ := by ring have hsum (n : ℕ) : (∑ k ∈ range n, ((k : ℝ) + 3) / (p : ℝ) ^ (k + 2)) ≤ 6 / (p : ℝ) ^ 2 - 2 * ((n : ℝ) + 3) / (p : ℝ) ^ (n + 2) := by induction n with | zero => norm_num | succ n ih => rw [sum_range_succ] have hs := hstep n simp only [Nat.cast_add, Nat.cast_one, Nat.cast_succ] rw [show (n : ℝ) + 1 + 3 = (n : ℝ) + 4 by ring, show n + 1 + 2 = n + 3 by omega] linarith only [ih, hs] exact (hsum N).trans (sub_le_self _ (by positivity)) /-- Layer-cake identity for one valuation, with a genuinely finite cutoff. -/ lemma valuation_excess_eq_sum {p n : ℕ} (hp : p.Prime) (hn : n ≠ 0) (N : ℕ) (hN : n.factorization p - 1 ≤ N) : ((n.factorization p - 1 : ℕ) : ℝ) = ∑ k ∈ range N, if p ^ (k + 2) ∣ n then (1 : ℝ) else 0 := by classical rw [sum_boole] have he : (range N).filter (fun k => p ^ (k + 2) ∣ n) = range (n.factorization p - 1) := by ext k simp only [mem_filter, mem_range, hp.pow_dvd_iff_le_factorization hn] omega rw [he, card_range] /-- First moment of one repeated split-prime valuation on actual Gaussian vectors. -/ theorem prime_excess_sum_le (p : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) {R : ℝ} (hR : 0 ≤ R) : (∑ z ∈ GaussianMass.representatives (R ^ 2), ((z.norm.natAbs.factorization p - 1 : ℕ) : ℝ)) ≤ 54 * Real.pi * R ^ 2 / (p : ℝ) ^ 2 := by classical let S := GaussianMass.representatives (R ^ 2) let N := S.sup (fun z => z.norm.natAbs.factorization p - 1) have hlayer (z : GaussianInt) (hz : z ∈ S) : ((z.norm.natAbs.factorization p - 1 : ℕ) : ℝ) = ∑ k ∈ range N, if p ^ (k + 2) ∣ z.norm.natAbs then (1 : ℝ) else 0 := by have hz0 := ((GaussianMass.mem_representatives (sq_nonneg R) z).mp hz).1 have hn : z.norm.natAbs ≠ 0 := by intro hn exact hz0 (GaussianInt.norm_eq_zero.mp (Int.natAbs_eq_zero.mp hn)) exact valuation_excess_eq_sum hp hn N (le_sup (f := fun z : GaussianInt => z.norm.natAbs.factorization p - 1) hz) calc _ = ∑ k ∈ range N, ((S.filter (fun z => p ^ (k + 2) ∣ z.norm.natAbs)).card : ℝ) := by change (∑ z ∈ S, _) = _ rw [sum_congr rfl hlayer, sum_comm] simp only [sum_boole] _ ≤ ∑ k ∈ range N, 9 * Real.pi * R ^ 2 * (((k : ℝ) + 3) / (p : ℝ) ^ (k + 2)) := by apply sum_le_sum intro k hk have he := pow_event_card_upper p hp hp4 (k + 2) hR have hkcast : ((k + 2 : ℕ) : ℝ) + 1 = (k : ℝ) + 3 := by push_cast ring simpa only [hkcast, mul_div_assoc] using he _ = 9 * Real.pi * R ^ 2 * (∑ k ∈ range N, ((k : ℝ) + 3) / (p : ℝ) ^ (k + 2)) := by rw [mul_sum] _ ≤ 9 * Real.pi * R ^ 2 * (6 / (p : ℝ) ^ 2) := mul_le_mul_of_nonneg_left (power_tail_sum_le p N (split_prime_five_le hp hp4)) (by positivity) _ = _ := by ring /-- A deliberately loose, universal reciprocal-square bound for arbitrary finite split sets. -/ lemma reciprocal_square_sum_le (T : Finset ℕ) (hT : ∀ p ∈ T, 5 ≤ p) : (∑ p ∈ T, 1 / (p : ℝ) ^ 2) ≤ 2 := by let b : ℕ → ℝ := fun n => 1 / ((n : ℝ) + 1) have hb (n : ℕ) : 0 ≤ b n - b (n + 1) := by dsimp [b] push_cast exact sub_nonneg.mpr (one_div_le_one_div_of_le (by positivity) (by linarith)) have ht (p : ℕ) (hp : 5 ≤ p) : 1 / (p : ℝ) ^ 2 ≤ 2 * (b p - b (p + 1)) := by have hpR : (5 : ℝ) ≤ p := by exact_mod_cast hp dsimp [b] push_cast have hp0 : (0 : ℝ) < p := by linarith have hp1 : (0 : ℝ) < p + 1 := by linarith have hp2 : (0 : ℝ) < p + 2 := by linarith field_simp nlinarith [sq_nonneg ((p : ℝ) - 5)] have htel (n : ℕ) : (∑ k ∈ range n, (b k - b (k + 1))) = 1 - b n := by induction n with | zero => simp [b] | succ n ih => rw [sum_range_succ, ih]; ring have hsub : T ⊆ range (T.sup id + 1) := by intro p hp exact mem_range.mpr (Nat.lt_succ_of_le (le_sup (f := id) hp)) calc _ ≤ ∑ p ∈ T, 2 * (b p - b (p + 1)) := sum_le_sum (fun p hp => ht p (hT p hp)) _ = 2 * ∑ p ∈ T, (b p - b (p + 1)) := by rw [mul_sum] _ ≤ 2 * ∑ p ∈ range (T.sup id + 1), (b p - b (p + 1)) := by apply mul_le_mul_of_nonneg_left _ (by norm_num) exact sum_le_sum_of_subset_of_nonneg hsub (fun p _ _ => hb p) _ = 2 * (1 - b (T.sup id + 1)) := by rw [htel] _ ≤ 2 := by have : 0 ≤ b (T.sup id + 1) := by dsimp [b] positivity linarith /-- Uniform repeated split-factor first moment; the constant is independent of the finite prime set and the radius. All events above count actual nonzero Gaussian integers. -/ theorem excess_sum_le (T : Finset ℕ) (hT : ∀ p ∈ T, p.Prime ∧ p % 4 = 1) {R : ℝ} (hR : 0 ≤ R) : (∑ z ∈ GaussianMass.representatives (R ^ 2), (excess T z : ℝ)) ≤ (108 * Real.pi) * R ^ 2 := by classical calc _ = ∑ z ∈ GaussianMass.representatives (R ^ 2), ∑ p ∈ T, ((z.norm.natAbs.factorization p - 1 : ℕ) : ℝ) := by apply sum_congr rfl intro z _ change ((∑ p ∈ T, (z.norm.natAbs.factorization p - 1) : ℕ) : ℝ) = _ exact Nat.cast_sum (R := ℝ) T (fun p => z.norm.natAbs.factorization p - 1) _ = ∑ p ∈ T, ∑ z ∈ GaussianMass.representatives (R ^ 2), ((z.norm.natAbs.factorization p - 1 : ℕ) : ℝ) := sum_comm _ ≤ ∑ p ∈ T, 54 * Real.pi * R ^ 2 / (p : ℝ) ^ 2 := sum_le_sum (fun p hp => prime_excess_sum_le p (hT p hp).1 (hT p hp).2 hR) _ = (54 * Real.pi * R ^ 2) * ∑ p ∈ T, 1 / (p : ℝ) ^ 2 := by rw [mul_sum] apply sum_congr rfl intro p hp ring _ ≤ (54 * Real.pi * R ^ 2) * 2 := mul_le_mul_of_nonneg_left (reciprocal_square_sum_le T (fun p hp => split_prime_five_le (hT p hp).1 (hT p hp).2)) (by positivity) _ = _ := by ring end DistanceCounts.GaussianExcess end end BodyFile020 -- Source: .tools/pnt-port/PrimeNumberTheoremAnd/Mathlib/Analysis/Asymptotics/Asymptotics.lean section BodyFile021 open Filter Topology namespace Asymptotics variable {α : Type*} {β : Type*} {E : Type*} {F : Type*} {G : Type*} {E' : Type*} {F' : Type*} {G' : Type*} {E'' : Type*} {F'' : Type*} {G'' : Type*} {R : Type*} {R' : Type*} {𝕜 : Type*} {𝕜' : Type*} variable [Norm E] [Norm F] [Norm G] variable [SeminormedAddCommGroup E'] [SeminormedAddCommGroup F'] [SeminormedAddCommGroup G'] [NormedAddCommGroup E''] [NormedAddCommGroup F''] [NormedAddCommGroup G''] [SeminormedRing R] [SeminormedRing R'] theorem isLittleO_const_id_cocompact [ProperSpace F''] (c : E'') : (fun _x : F'' => c) =o[cocompact F''] id := isLittleO_const_left.2 <| Or.inr tendsto_norm_cocompact_atTop -- to replace existing `isLittleO_const_id_atTop` theorem isLittleO_const_id_atTop2 [LinearOrder F''] [NoMaxOrder F''] [ClosedIciTopology F''] [ProperSpace F''] (c : E'') : (fun _x : F'' => c) =o[atTop] id := (isLittleO_const_id_cocompact c).mono atTop_le_cocompact -- to replace existing `isLittleO_const_id_atBot` theorem isLittleO_const_id_atBot2 [LinearOrder F''] [NoMinOrder F''] [ClosedIicTopology F''] [ProperSpace F''] (c : E'') : (fun _x : F'' => c) =o[atBot] id := (isLittleO_const_id_cocompact c).mono atBot_le_cocompact theorem _root_.Filter.Eventually.natCast {f : ℝ → Prop} (hf : ∀ᶠ x in atTop, f x) : ∀ᶠ n : ℕ in atTop, f n := tendsto_natCast_atTop_atTop.eventually hf theorem IsBigO.natCast {f g : ℝ → E} (h : f =O[atTop] g) : (fun n : ℕ => f n) =O[atTop] fun n : ℕ => g n := h.comp_tendsto tendsto_natCast_atTop_atTop end Asymptotics end BodyFile021 -- Source: .tools/pnt-port/PrimeNumberTheoremAnd/Sobolev.lean section BodyFile022 open Real Complex MeasureTheory Filter Topology BoundedContinuousFunction SchwartzMap BigOperators open scoped ContDiff variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] {n : ℕ} structure CS (n : ℕ) (E : Type*) [NormedAddCommGroup E] [NormedSpace ℝ E] where toFun : ℝ → E h1 : ContDiff ℝ n toFun h2 : HasCompactSupport toFun structure trunc extends (CS 2 ℝ) where h3 : (Set.Icc (-1) (1)).indicator 1 ≤ toFun h4 : toFun ≤ Set.indicator (Set.Ioo (-2) (2)) 1 structure W1 (n : ℕ) (E : Type*) [NormedAddCommGroup E] [NormedSpace ℝ E] where toFun : ℝ → E smooth : ContDiff ℝ n toFun integrable : ∀ ⦃k⦄, k ≤ n → Integrable (iteratedDeriv k toFun) abbrev W21 := W1 2 ℂ section lemmas noncomputable def funscale {E : Type*} (g : ℝ → E) (R x : ℝ) : E := g (R⁻¹ • x) lemma contDiff_ofReal : ContDiff ℝ ∞ ofReal := by have key x : HasDerivAt ofReal 1 x := hasDerivAt_id x |>.ofReal_comp have key' : deriv ofReal = fun _ => 1 := by ext x ; exact (key x).deriv refine contDiff_infty_iff_deriv.mpr ⟨fun x => (key x).differentiableAt, ?_⟩ simpa [key'] using contDiff_const omit [NormedSpace ℝ E] in lemma tendsto_funscale {f : ℝ → E} (hf : ContinuousAt f 0) (x : ℝ) : Tendsto (fun R => funscale f R x) atTop (𝓝 (f 0)) := hf.tendsto.comp (by simpa using tendsto_inv_atTop_zero.mul_const x) end lemmas namespace CS variable {f : CS n E} {R x v : ℝ} abbrev coeFunDict : CoeFun (CS n E) (fun _ => ℝ → E) where coe := CS.toFun abbrev realComplexDict : Coe (CS n ℝ) (CS n ℂ) := by letI := @coeFunDict exact ⟨fun f => ⟨fun x => f x, contDiff_ofReal.of_le (mod_cast le_top) |>.comp f.h1, f.h2.comp_left (g := ofReal) rfl⟩⟩ lemma ext_toFun {f g : CS n E} (h : f.toFun = g.toFun) : f = g := by cases f cases g cases h rfl def neg (f : CS n E) : CS n E where toFun := -f.toFun h1 := f.h1.neg h2 := by simpa [HasCompactSupport, tsupport] using f.h2 abbrev negDict : Neg (CS n E) where neg := neg lemma neg_apply {x : ℝ} : letI := @coeFunDict letI := @negDict (-f) x = - (f x) := by letI := @coeFunDict letI := @negDict rfl def smul (R : ℝ) (f : CS n E) : CS n E := ⟨R • f.toFun, f.h1.const_smul R, f.h2.smul_left⟩ abbrev smulDict : HSMul ℝ (CS n E) (CS n E) where hSMul := smul lemma smul_apply : letI := @coeFunDict letI := @smulDict (R • f) x = R • f x := by letI := @coeFunDict letI := @smulDict rfl lemma continuous (f : CS n E) : Continuous f.toFun := f.h1.continuous noncomputable def deriv (f : CS (n + 1) E) : CS n E where toFun := _root_.deriv f.toFun h1 := (contDiff_succ_iff_deriv.mp f.h1).2.2 h2 := f.h2.deriv lemma hasDerivAt (f : CS (n + 1) E) (x : ℝ) : HasDerivAt f.toFun (f.deriv.toFun x) x := (f.h1.differentiable (by simp)).differentiableAt.hasDerivAt lemma deriv_apply {f : CS (n + 1) E} {x : ℝ} : f.deriv.toFun x = _root_.deriv f.toFun x := rfl lemma deriv_smul {f : CS (n + 1) E} : letI := @coeFunDict letI := @smulDict (R • f).deriv = R • f.deriv := by letI := @coeFunDict letI := @smulDict apply ext_toFun funext x exact (f.hasDerivAt x |>.const_smul R).deriv noncomputable def scale (g : CS n E) (R : ℝ) : CS n E := by by_cases h : R = 0 · exact ⟨0, contDiff_const, by simp [HasCompactSupport, tsupport]⟩ · refine ⟨fun x => funscale g.toFun R x, ?_, ?_⟩ · exact g.h1.comp (contDiff_const_smul R⁻¹) · exact g.h2.comp_smul (inv_ne_zero h) lemma deriv_scale {f : CS (n + 1) E} : letI := @coeFunDict letI := @smulDict (f.scale R).deriv = R⁻¹ • f.deriv.scale R := by letI := @coeFunDict letI := @smulDict apply ext_toFun funext v change (f.scale R).deriv v = (R⁻¹ • f.deriv.scale R) v by_cases hR : R = 0 · simp [hR, scale, deriv, smul_apply] · simp only [scale, hR, ↓reduceDIte, smul_apply] exact ((f.hasDerivAt (R⁻¹ • v)).scomp v (by simpa using! (hasDerivAt_id v).const_smul R⁻¹)).deriv lemma deriv_scale' {f : CS (n + 1) E} : letI := @coeFunDict letI := @smulDict (f.scale R).deriv v = R⁻¹ • f.deriv (R⁻¹ • v) := by letI := @coeFunDict letI := @smulDict rw [deriv_scale, smul_apply] by_cases hR : R = 0 <;> simp [hR, scale, funscale] lemma hasDerivAt_scale (f : CS (n + 1) E) (R x : ℝ) : letI := @coeFunDict HasDerivAt (f.scale R) (R⁻¹ • _root_.deriv f (R⁻¹ • x)) x := by letI := @coeFunDict convert hasDerivAt (f.scale R) x ; rw [deriv_scale'] ; rfl lemma tendsto_scale (f : CS n E) (x : ℝ) : letI := @coeFunDict Tendsto (fun R => f.scale R x) atTop (𝓝 (f 0)) := by letI := @coeFunDict apply (tendsto_funscale f.continuous.continuousAt x).congr' filter_upwards [eventually_ne_atTop 0] with R hR ; simp [scale, hR] lemma bounded : ∃ C, ∀ v, ‖f.toFun v‖ ≤ C := by obtain ⟨x, hx⟩ := (continuous_norm.comp f.continuous).exists_forall_ge_of_hasCompactSupport f.h2.norm exact ⟨_, hx⟩ end CS namespace trunc abbrev coeFunDict : CoeFun trunc (fun _ => ℝ → ℝ) where coe f := f.toFun abbrev csDict : Coe trunc (CS 2 ℝ) where coe := trunc.toCS lemma nonneg (g : trunc) (x : ℝ) : 0 ≤ g.toFun x := (Set.indicator_nonneg (by simp) x).trans (g.h3 x) lemma le_one (g : trunc) (x : ℝ) : g.toFun x ≤ 1 := (g.h4 x).trans <| Set.indicator_le_self' (by simp) x lemma zero (g : trunc) : g.toFun =ᶠ[𝓝 0] 1 := by have : Set.Icc (-1) 1 ∈ 𝓝 (0 : ℝ) := by apply Icc_mem_nhds <;> linarith exact eventually_of_mem this (fun x hx => le_antisymm (g.le_one x) (by simpa [hx] using g.h3 x)) lemma zero_at {g : trunc} : g.toFun 0 = 1 := g.zero.eq_of_nhds end trunc namespace W1 abbrev coeFunDict : CoeFun (W1 n E) (fun _ => ℝ → E) where coe := W1.toFun lemma continuous (f : W1 n E) : Continuous f.toFun := f.smooth.continuous lemma differentiable (f : W1 (n + 1) E) : Differentiable ℝ f.toFun := f.smooth.differentiable (by simp) lemma iteratedDeriv_sub {f g : ℝ → E} (hf : ContDiff ℝ n f) (hg : ContDiff ℝ n g) : iteratedDeriv n (f - g) = iteratedDeriv n f - iteratedDeriv n g := by induction n generalizing f g with | zero => rfl | succ n ih => have hf' : ContDiff ℝ n (deriv f) := hf.iterate_deriv' n 1 have hg' : ContDiff ℝ n (deriv g) := hg.iterate_deriv' n 1 have hfg : deriv (f - g) = deriv f - deriv g := by ext x ; apply deriv_sub · exact (hf.differentiable (by simp)).differentiableAt · exact (hg.differentiable (by simp)).differentiableAt simp_rw [iteratedDeriv_succ', ← ih hf' hg', hfg] noncomputable def deriv (f : W1 (n + 1) E) : W1 n E where toFun := _root_.deriv f.toFun smooth := contDiff_succ_iff_deriv.mp f.smooth |>.2.2 integrable k hk := by simpa [iteratedDeriv_succ'] using f.integrable (Nat.succ_le_succ hk) lemma hasDerivAt (f : W1 (n + 1) E) (x : ℝ) : HasDerivAt f.toFun (f.deriv.toFun x) x := f.differentiable.differentiableAt.hasDerivAt def sub (f g : W1 n E) : W1 n E where toFun := f.toFun - g.toFun smooth := f.smooth.sub g.smooth integrable k hk := by have hf : ContDiff ℝ k f.toFun := f.smooth.of_le (by simp [hk]) have hg : ContDiff ℝ k g.toFun := g.smooth.of_le (by simp [hk]) simpa [iteratedDeriv_sub hf hg] using (f.integrable hk).sub (g.integrable hk) abbrev subDict : Sub (W1 n E) where sub := sub lemma integrable_iteratedDeriv_Schwarz {f : 𝓢(ℝ, ℂ)} : Integrable (iteratedDeriv n f) := by induction n generalizing f with | zero => exact f.integrable | succ n ih => simpa [iteratedDeriv_succ'] using! ih (f := SchwartzMap.derivCLM ℝ ℂ f) noncomputable def of_Schwartz (f : 𝓢(ℝ, ℂ)) : W1 n ℂ where toFun := f smooth := f.smooth n integrable _ _ := integrable_iteratedDeriv_Schwarz end W1 namespace W21 variable {f : W21} noncomputable def norm (f : ℝ → ℂ) : ℝ := (∫ v, ‖f v‖) + (4 * π ^ 2)⁻¹ * (∫ v, ‖deriv (deriv f) v‖) lemma norm_nonneg {f : ℝ → ℂ} : 0 ≤ norm f := add_nonneg (integral_nonneg (fun t => by simp)) (mul_nonneg (by positivity) (integral_nonneg (fun t => by simp))) noncomputable abbrev normDict : Norm W21 where norm := norm ∘ W1.toFun noncomputable abbrev schwartzDict : Coe 𝓢(ℝ, ℂ) W21 where coe := W1.of_Schwartz def ofCS2 (f : CS 2 ℂ) : W21 := by refine ⟨f.toFun, f.h1, fun k hk => ?_⟩ ; match k with | 0 => exact f.h1.continuous.integrable_of_hasCompactSupport f.h2 | 1 => simpa using (f.h1.continuous_deriv one_le_two).integrable_of_hasCompactSupport f.h2.deriv | 2 => simpa [iteratedDeriv_succ] using (f.h1.iterate_deriv' 0 2).continuous.integrable_of_hasCompactSupport f.h2.deriv.deriv abbrev csDict : Coe (CS 2 ℂ) W21 where coe := ofCS2 abbrev mulComplexDict : HMul (CS 2 ℂ) W21 (CS 2 ℂ) where hMul g f := ⟨g.toFun * f.toFun, g.h1.mul f.smooth, g.h2.mul_right⟩ abbrev mulRealDict : HMul (CS 2 ℝ) W21 (CS 2 ℂ) := by letI := @CS.realComplexDict letI := mulComplexDict exact ⟨fun g f => (g : CS 2 ℂ) * f⟩ lemma hf (f : W21) : Integrable f.toFun := f.integrable zero_le_two lemma hf' (f : W21) : Integrable (deriv f.toFun) := by simpa [iteratedDeriv_succ] using f.integrable one_le_two lemma hf'' (f : W21) : Integrable (deriv (deriv f.toFun)) := by simpa [iteratedDeriv_succ] using f.integrable le_rfl end W21 theorem W21_approximation (f : W21) (g : trunc) : letI := @CS.coeFunDict letI := @CS.realComplexDict letI := @CS.negDict letI := @CS.smulDict letI := trunc.coeFunDict letI := trunc.csDict letI := @W1.coeFunDict letI := @W1.subDict letI := W21.normDict letI := W21.csDict letI := W21.mulComplexDict letI := W21.mulRealDict Tendsto (fun R => ‖f - (g.scale R * f : W21)‖) atTop (𝓝 0) := by letI := @CS.coeFunDict letI := @CS.realComplexDict letI := @CS.negDict letI := @CS.smulDict letI := trunc.coeFunDict letI := trunc.csDict letI := @W1.coeFunDict letI := @W1.subDict letI := W21.normDict letI := W21.csDict letI := W21.mulComplexDict letI := W21.mulRealDict -- Definitions let f' := f.deriv let f'' := f'.deriv let g' := (g : CS 2 ℝ).deriv let g'' := g'.deriv let h R v := 1 - g.scale R v let h' R := - (g.scale R).deriv let h'' R := - (g.scale R).deriv.deriv -- Properties of h have ch {R} : Continuous (fun v => (h R v : ℂ)) := continuous_ofReal.comp <| continuous_const.sub (CS.continuous _) have ch' {R} : Continuous (fun v => (h' R v : ℂ)) := continuous_ofReal.comp (CS.continuous _) have ch'' {R} : Continuous (fun v => (h'' R v : ℂ)) := continuous_ofReal.comp (CS.continuous _) have dh R v : HasDerivAt (h R) (h' R v) v := by convert! CS.hasDerivAt_scale (g : CS 2 ℝ) R v |>.const_sub 1 using 1 simp [h', CS.neg_apply, CS.deriv_scale', show g.deriv.toFun = deriv g.toFun from rfl] have dh' R v : HasDerivAt (h' R) (h'' R v) v := ((g.scale R).deriv.hasDerivAt v).neg have hh1 R v : |h R v| ≤ 1 := by by_cases hR : R = 0 <;> simp only [CS.scale, funscale, smul_eq_mul, hR, ↓reduceDIte, Pi.zero_apply, sub_zero, abs_one, le_refl, h] rw [abs_le] ; constructor <;> linarith [g.le_one (R⁻¹ * v), g.nonneg (R⁻¹ * v)] have vR v : Tendsto (fun R : ℝ => v * R⁻¹) atTop (𝓝 0) := by simpa using tendsto_inv_atTop_zero.const_mul v -- Proof convert_to Tendsto (fun R => W21.norm (fun v => h R v * f v)) atTop (𝓝 0) · ext R ; change W21.norm _ = _ ; congr ; ext v ; simp [h, sub_mul] ; rfl rw [show (0 : ℝ) = 0 + ((4 * π ^ 2)⁻¹ : ℝ) * 0 by simp] refine Tendsto.add ?_ (Tendsto.const_mul _ ?_) · let F R v := ‖h R v * f v‖ have eh v : ∀ᶠ R in atTop, h R v = 0 := by filter_upwards [(vR v).eventually g.zero, eventually_ne_atTop 0] with R hR hR' simp [h, hR, CS.scale, hR', funscale, mul_comm R⁻¹] have e1 : ∀ᶠ (n : ℝ) in atTop, AEStronglyMeasurable (F n) volume := by apply Eventually.of_forall ; intro R exact (ch.mul f.continuous).norm.aestronglyMeasurable have e2 : ∀ᶠ (n : ℝ) in atTop, ∀ᵐ (a : ℝ), ‖F n a‖ ≤ ‖f a‖ := by apply Eventually.of_forall ; intro R apply Eventually.of_forall ; intro v simpa [F] using mul_le_mul (hh1 R v) le_rfl (by simp) zero_le_one have e4 : ∀ᵐ (a : ℝ), Tendsto (fun n ↦ F n a) atTop (𝓝 0) := by apply Eventually.of_forall ; intro v apply tendsto_nhds_of_eventually_eq ; filter_upwards [eh v] with R hR ; simp [F, hR] simpa [F] using tendsto_integral_filter_of_dominated_convergence _ e1 e2 f.hf.norm e4 · let F R v := ‖h'' R v * f v + 2 * h' R v * f' v + h R v * f'' v‖ convert_to Tendsto (fun R ↦ ∫ (v : ℝ), F R v) atTop (𝓝 0) · have this R v : deriv (deriv (fun v => h R v * f v)) v = h'' R v * f v + 2 * h' R v * f' v + h R v * f'' v := by have df v : HasDerivAt f (f' v) v := f.hasDerivAt v have df' v : HasDerivAt f' (f'' v) v := f'.hasDerivAt v have l3 v : HasDerivAt (fun v => h R v * f v) (h' R v * f v + h R v * f' v) v := (dh R v).ofReal_comp.mul (df v) have l5 : HasDerivAt (fun v => h' R v * f v) (h'' R v * f v + h' R v * f' v) v := (dh' R v).ofReal_comp.mul (df v) have l7 : HasDerivAt (fun v => h R v * f' v) (h' R v * f' v + h R v * f'' v) v := (dh R v).ofReal_comp.mul (df' v) have d1 : deriv (fun v => h R v * f v) = fun v => h' R v * f v + h R v * f' v := funext (fun v => (l3 v).deriv) rw [d1] ; convert! (l5.add l7).deriv using 1 ; ring simp_rw [this, F] obtain ⟨c1, mg'⟩ := g'.bounded obtain ⟨c2, mg''⟩ := g''.bounded let bound v := c2 * ‖f v‖ + 2 * c1 * ‖f' v‖ + ‖f'' v‖ have e1 : ∀ᶠ (n : ℝ) in atTop, AEStronglyMeasurable (F n) volume := by apply Eventually.of_forall ; intro R ; apply (Continuous.norm ?_).aestronglyMeasurable exact ((ch''.mul f.continuous).add ((continuous_const.mul ch').mul f.deriv.continuous)).add (ch.mul f.deriv.deriv.continuous) have e2 : ∀ᶠ R in atTop, ∀ᵐ (a : ℝ), ‖F R a‖ ≤ bound a := by have hc1 : ∀ᶠ R in atTop, ∀ v, |h' R v| ≤ c1 := by filter_upwards [eventually_ge_atTop 1] with R hR v have hR' : R ≠ 0 := by linarith have : 0 ≤ R := by linarith simp only [CS.deriv_scale, CS.neg_apply, CS.smul_apply, smul_eq_mul, abs_neg, abs_mul, abs_inv, abs_eq_self.mpr this, ge_iff_le, h'] simp only [CS.scale, hR', ↓reduceDIte, funscale, smul_eq_mul] convert_to _ ≤ c1 * 1 · simp · rw [mul_comm] apply mul_le_mul (mg' _) (inv_le_of_inv_le₀ (by linarith) (by simpa using hR)) (by positivity) exact (abs_nonneg _).trans (mg' 0) have hc2 : ∀ᶠ R in atTop, ∀ v, |h'' R v| ≤ c2 := by filter_upwards [eventually_ge_atTop 1] with R hR v have e1 : 0 ≤ R := by linarith have e2 : R⁻¹ ≤ 1 := inv_le_of_inv_le₀ (by linarith) (by simpa using hR) have e3 : R ≠ 0 := by linarith simp only [CS.deriv_scale, CS.deriv_smul, CS.neg_apply, CS.smul_apply, smul_eq_mul, abs_neg, abs_mul, abs_inv, abs_eq_self.mpr e1, ge_iff_le, h''] convert_to _ ≤ 1 * (1 * c2) · simp apply mul_le_mul e2 ?_ (by positivity) zero_le_one apply mul_le_mul e2 ?_ (by positivity) zero_le_one simp only [CS.scale, e3, ↓reduceDIte, funscale, smul_eq_mul] ; apply mg'' filter_upwards [hc1, hc2] with R hc1 hc2 apply Eventually.of_forall ; intro v ; specialize hc1 v ; specialize hc2 v simp only [F, bound, norm_norm] refine (norm_add_le _ _).trans ?_ ; apply add_le_add · refine (norm_add_le _ _).trans ?_ ; apply add_le_add <;> simp only [Complex.norm_mul, Complex.norm_ofNat, norm_real, norm_eq_abs] <;> gcongr · simpa using mul_le_mul (hh1 R v) le_rfl (by simp) zero_le_one have e3 : Integrable bound volume := (((f.hf.norm).const_mul _).add ((f.hf'.norm).const_mul _)).add f.hf''.norm have e4 : ∀ᵐ (a : ℝ), Tendsto (fun n ↦ F n a) atTop (𝓝 0) := by apply Eventually.of_forall ; intro v have evg' : g' =ᶠ[𝓝 0] 0 := by convert! ← g.zero.deriv ; exact deriv_const' _ have evg'' : g'' =ᶠ[𝓝 0] 0 := by convert! ← evg'.deriv ; exact deriv_const' _ refine tendsto_norm_zero.comp <| (ZeroAtFilter.add ?_ ?_).add ?_ · have eh'' v : ∀ᶠ R in atTop, h'' R v = 0 := by filter_upwards [(vR v).eventually evg'', eventually_ne_atTop 0] with R hR hR' simp only [CS.deriv_scale, CS.deriv_smul, CS.neg_apply, CS.smul_apply, smul_eq_mul, neg_eq_zero, mul_eq_zero, inv_eq_zero, hR', false_or, h''] simp only [CS.scale, hR', ↓reduceDIte, funscale, smul_eq_mul, mul_comm R⁻¹] exact hR apply tendsto_nhds_of_eventually_eq filter_upwards [eh'' v] with R hR ; simp [hR] · have eh' v : ∀ᶠ R in atTop, h' R v = 0 := by filter_upwards [(vR v).eventually evg'] with R hR simp [g'] at hR simp [h', CS.neg_apply, CS.deriv_scale', mul_comm R⁻¹, hR] apply tendsto_nhds_of_eventually_eq filter_upwards [eh' v] with R hR ; simp [hR] · simpa [h, trunc.zero_at] using! ((g.tendsto_scale v).const_sub 1).ofReal.mul tendsto_const_nhds simpa [F] using tendsto_integral_filter_of_dominated_convergence bound e1 e2 e3 e4 end BodyFile022 -- Source: .tools/pnt-port/PrimeNumberTheoremAnd/Fourier.lean section BodyFile023 open FourierTransform Real Complex MeasureTheory Filter Topology BoundedContinuousFunction SchwartzMap VectorFourier BigOperators abbrev realFunctionCoeDict (E : Type*) : Coe (E → ℝ) (E → ℂ) := ⟨fun f n => f n⟩ section lemmas theorem nnnorm_eq_of_mem_circle (z : Circle) : ‖z.val‖₊ = 1 := NNReal.coe_eq_one.mp (Circle.norm_coe z) theorem nnnorm_circle_smul (z : Circle) (s : ℂ) : ‖z • s‖₊ = ‖s‖₊ := by simp [show z • s = z.val * s from rfl, nnnorm_eq_of_mem_circle] noncomputable def e (u : ℝ) : ℝ →ᵇ ℂ where toFun v := 𝐞 (-v * u) map_bounded' := ⟨2, fun x y => (dist_le_norm_add_norm _ _).trans (by simp [Circle.norm_coe, one_add_one_eq_two])⟩ lemma e_apply (u : ℝ) (v : ℝ) : e u v = 𝐞 (-v * u) := rfl theorem hasDerivAt_e {u x : ℝ} : HasDerivAt (e u) (-2 * π * u * I * e u x) x := by have l2 : HasDerivAt (fun v => -v * u) (-u) x := by simpa only [neg_mul_comm] using hasDerivAt_mul_const (-u) convert! (hasDerivAt_fourierChar (-x * u)).scomp x l2 using 1 change _ = ((-u : ℝ) : ℂ) * _ -- `scomp` introduces ℝ-smul on ℂ, which we undo simp [e_apply] ; ring lemma fourierIntegral_deriv_aux2 (e : ℝ →ᵇ ℂ) {f : ℝ → ℂ} (hf : Integrable f) : Integrable (⇑e * f) := hf.bdd_mul e.continuous.aestronglyMeasurable (ae_of_all _ e.norm_coe_le_norm) lemma F_neg {f : ℝ → ℂ} {u : ℝ} : 𝓕 (fun x => -f x) u = - 𝓕 f u := by simp [fourier_eq, integral_neg] lemma F_add {f g : ℝ → ℂ} (hf : Integrable f) (hg : Integrable g) (x : ℝ) : 𝓕 (fun x => f x + g x) x = 𝓕 f x + 𝓕 g x := by have : Continuous fun p : ℝ × ℝ ↦ ((innerₗ ℝ) p.1) p.2 := continuous_inner have := fourierIntegral_add continuous_fourierChar this hf hg exact congr_fun this x lemma F_sub {f g : ℝ → ℂ} (hf : Integrable f) (hg : Integrable g) (x : ℝ) : 𝓕 (fun x => f x - g x) x = 𝓕 f x - 𝓕 g x := by simpa [sub_eq_add_neg, Pi.neg_def, F_neg] using F_add hf hg.neg x lemma F_mul {f : ℝ → ℂ} {c : ℂ} {u : ℝ} : 𝓕 (fun x => c * f x) u = c * 𝓕 f u := by exact congr_fun (VectorFourier.fourierIntegral_const_smul 𝐞 _ _ f c) u end lemmas theorem fourierIntegral_self_add_deriv_deriv : letI := @W1.coeFunDict ∀ (f : W21) (u : ℝ), (1 + u ^ 2) * 𝓕 (f : ℝ → ℂ) u = 𝓕 (fun u : ℝ => (f u - (1 / (4 * π ^ 2)) * deriv^[2] f u : ℂ)) u := by letI := @W1.coeFunDict intro f u have l1 : Integrable (fun x => (((π : ℂ) ^ 2)⁻¹ * 4⁻¹) * deriv (deriv f) x) := by apply Integrable.const_mul ; simpa [iteratedDeriv_succ] using f.integrable le_rfl have l4 : Differentiable ℝ f := f.differentiable have l5 : Differentiable ℝ (deriv f) := f.deriv.differentiable simp [f.hf, l1, add_mul, F_sub, F_mul, Real.fourier_deriv f.hf' l5 f.hf'', Real.fourier_deriv f.hf l4 f.hf'] field_simp [pi_ne_zero] ; ring_nf ; simp lemma deriv_ofReal : deriv ofReal = fun _ => 1 := by ext x ; exact ((hasDerivAt_id x).ofReal_comp).deriv /-- If, eventually in `T`, the integrand `f T` is bounded on `uIoc lo hi` by `B T` and `B T * |hi - lo| → 0`, then the interval integral `∫ x in lo..hi, f T x → 0`. -/ lemma tendsto_intervalIntegral_zero_of_uniform_norm_bound {f : ℝ → ℝ → ℂ} {lo hi : ℝ} {B : ℝ → ℝ} (hB : Filter.Tendsto (fun T : ℝ => B T * |hi - lo|) Filter.atTop (nhds 0)) (hf : ∀ᶠ T in Filter.atTop, ∀ x ∈ Set.uIoc lo hi, ‖f T x‖ ≤ B T) : Filter.Tendsto (fun T : ℝ => ∫ x in lo..hi, f T x) Filter.atTop (nhds 0) := by rw [tendsto_zero_iff_norm_tendsto_zero] refine squeeze_zero' (Eventually.of_forall fun T => norm_nonneg _) ?_ hB filter_upwards [hf] with T hT exact intervalIntegral.norm_integral_le_of_norm_le_const (fun x hx => hT x hx) /-- The decay `K * (log (T + 2) / (T + 2)) → 0` as `T → ∞`, for any constant `K`. -/ lemma tendsto_const_mul_log_add_two_div_add_two_atTop (K : ℝ) : Filter.Tendsto (fun T : ℝ => K * (Real.log (T + 2) / (T + 2))) Filter.atTop (nhds 0) := by have h0 : Filter.Tendsto (fun x : ℝ => Real.log x / x) Filter.atTop (nhds 0) := by simpa using (Real.tendsto_pow_log_div_mul_add_atTop 1 0 1 (by norm_num : (1 : ℝ) ≠ 0)) have hshift : Filter.Tendsto (fun T : ℝ => Real.log (T + 2) / (T + 2)) Filter.atTop (nhds 0) := by have := h0.comp (tendsto_atTop_add_const_right Filter.atTop 2 tendsto_id) simpa [Function.comp_def] using this simpa using hshift.const_mul K /-- Fourier-transform decay from an integrable derivative: for integrable, differentiable `g` with integrable derivative, `‖𝓕 g w‖ ≤ (∫ ‖deriv g x‖) / (2π·|w|)`. -/ lemma norm_fourier_le_integral_deriv_div (g : ℝ → ℂ) (hg : Integrable g) (hdiff : Differentiable ℝ g) (hg' : Integrable (deriv g)) {w : ℝ} (hw : w ≠ 0) : ‖𝓕 g w‖ ≤ (∫ x, ‖deriv g x‖ ∂volume) / ((2 * Real.pi) * |w|) := by have hmul : 𝓕 (deriv g) w = (2 * Real.pi * Complex.I * (w : ℂ)) * 𝓕 g w := by have h := congrFun (Real.fourier_deriv hg hdiff hg') w simpa [smul_eq_mul, mul_assoc] using h have h_fourier : ‖𝓕 (deriv g) w‖ ≤ ∫ x, ‖deriv g x‖ ∂volume := by exact VectorFourier.norm_fourierIntegral_le_integral_norm 𝐞 volume (innerₗ ℝ) (deriv g) w have hleft : ((2 * Real.pi) * |w|) * ‖𝓕 g w‖ = ‖(2 * Real.pi * Complex.I * (w : ℂ)) * 𝓕 g w‖ := by have htwopi : ‖(2 * ↑Real.pi : ℂ)‖ = 2 * Real.pi := by rw [norm_mul, Complex.norm_two, Complex.norm_of_nonneg Real.pi_pos.le] have hwc : ‖(w : ℂ)‖ = |w| := by rw [norm_real, Real.norm_eq_abs] rw [norm_mul, norm_mul, norm_mul, htwopi, norm_I, hwc] ring have hmain : ((2 * Real.pi) * |w|) * ‖𝓕 g w‖ ≤ ∫ x, ‖deriv g x‖ ∂volume := by rw [hleft, ← hmul] exact h_fourier have hpos : 0 < (2 * Real.pi) * |w| := by positivity exact (le_div_iff₀ hpos).mpr (by simpa [mul_comm, mul_left_comm, mul_assoc] using hmain) /-- The oscillatory-integral form of the decay bound: for `0 < T`, `‖∫ g y · exp(T·i·y)‖ ≤ (∫ ‖deriv g x‖) / T`. -/ lemma norm_oscillatory_integral_le_integral_deriv_div (g : ℝ → ℂ) (hg : Integrable g) (hdiff : Differentiable ℝ g) (hg' : Integrable (deriv g)) {T : ℝ} (hT : 0 < T) : ‖∫ y, g y * exp ((T : ℂ) * Complex.I * (y : ℂ)) ∂volume‖ ≤ (∫ x, ‖deriv g x‖ ∂volume) / T := by have hw : -T / (2 * Real.pi) ≠ 0 := by exact div_ne_zero (neg_ne_zero.mpr hT.ne') (mul_ne_zero two_ne_zero Real.pi_ne_zero) have hfourier := norm_fourier_le_integral_deriv_div g hg hdiff hg' hw have heq : (∫ y, g y * exp ((T : ℂ) * Complex.I * (y : ℂ)) ∂volume) = 𝓕 g (-T / (2 * Real.pi)) := by rw [Real.fourier_real_eq_integral_exp_smul] apply integral_congr_ae filter_upwards with y rw [smul_eq_mul] rw [mul_comm (g y)] congr 1 congr 1 push_cast field_simp [Real.pi_ne_zero] rw [heq] refine hfourier.trans_eq ?_ congr 1 have hden : (2 * Real.pi) * |-T / (2 * Real.pi)| = T := by have htwopi_pos : 0 < 2 * Real.pi := by positivity have hneg : -T / (2 * Real.pi) < 0 := div_neg_of_neg_of_pos (neg_neg_of_pos hT) htwopi_pos rw [abs_of_neg hneg] field_simp [Real.pi_ne_zero] rw [hden] /-- The `|T|` variant of the oscillatory-integral decay bound: for `T ≠ 0`, `‖∫ g y · exp(T·i·y)‖ ≤ (∫ ‖deriv g x‖) / |T|`. -/ lemma norm_oscillatory_integral_le_integral_deriv_div_abs (g : ℝ → ℂ) (hg : Integrable g) (hdiff : Differentiable ℝ g) (hg' : Integrable (deriv g)) {T : ℝ} (hT : T ≠ 0) : ‖∫ y, g y * exp ((T : ℂ) * Complex.I * (y : ℂ)) ∂volume‖ ≤ (∫ x, ‖deriv g x‖ ∂volume) / |T| := by have hw : -T / (2 * Real.pi) ≠ 0 := by exact div_ne_zero (neg_ne_zero.mpr hT) (mul_ne_zero two_ne_zero Real.pi_ne_zero) have hfourier := norm_fourier_le_integral_deriv_div g hg hdiff hg' hw have heq : (∫ y, g y * exp ((T : ℂ) * Complex.I * (y : ℂ)) ∂volume) = 𝓕 g (-T / (2 * Real.pi)) := by rw [Real.fourier_real_eq_integral_exp_smul] apply integral_congr_ae filter_upwards with y rw [smul_eq_mul] rw [mul_comm (g y)] congr 1 congr 1 push_cast field_simp [Real.pi_ne_zero] rw [heq] refine hfourier.trans_eq ?_ congr 1 have hden : (2 * Real.pi) * |-T / (2 * Real.pi)| = |T| := by have htwopi_pos : 0 < 2 * Real.pi := by positivity rw [abs_div, abs_neg, abs_of_pos htwopi_pos] field_simp [Real.pi_ne_zero] rw [hden] end BodyFile023 -- Source: .tools/pnt-port/PrimeNumberTheoremAnd/Mathlib/Algebra/Notation/Support.lean section BodyFile024 namespace Function variable {α : Type*} [Zero α] theorem support_id : support (id : α → α) = {0}ᶜ := by ext; simp theorem support_id' {α : Type*} [Zero α] : support (fun x : α ↦ x) = {0}ᶜ := support_id end Function end BodyFile024 -- Source: .tools/pnt-port/PrimeNumberTheoremAnd/SmoothExistence.lean section BodyFile025 open MeasureTheory Set Real open scoped ContDiff lemma smooth_urysohn_support_Ioo {a b c d : ℝ} (h1 : a < b) (h3 : c < d) : ∃ Ψ : ℝ → ℝ, (ContDiff ℝ ∞ Ψ) ∧ (HasCompactSupport Ψ) ∧ Set.indicator (Set.Icc b c) 1 ≤ Ψ ∧ Ψ ≤ Set.indicator (Set.Ioo a d) 1 ∧ (Function.support Ψ = Set.Ioo a d) := by have := exists_contMDiff_zero_iff_one_iff_of_isClosed (n := ⊤) (modelWithCornersSelf ℝ ℝ) (s := Set.Iic a ∪ Set.Ici d) (t := Set.Icc b c) (IsClosed.union isClosed_Iic isClosed_Ici) isClosed_Icc (by simp_rw [Set.disjoint_union_left, Set.disjoint_iff, Set.subset_def, Set.mem_inter_iff, Set.mem_Iic, Set.mem_Icc, Set.mem_empty_iff_false, and_imp, imp_false, not_le, Set.mem_Ici] constructor <;> intros <;> linarith) obtain ⟨Ψ, hΨSmooth, hΨrange, hΨ0, hΨ1⟩ := this simp only [Set.mem_union, Set.mem_Iic, Set.mem_Ici, Set.mem_Icc] at * use Ψ simp only [range_subset_iff, mem_Icc] at hΨrange refine ⟨ContMDiff.contDiff hΨSmooth, ?_, ?_, ?_, ?_⟩ · apply HasCompactSupport.of_support_subset_isCompact (K := Set.Icc a d) isCompact_Icc simp only [Function.support_subset_iff, ne_eq, mem_Icc, ← hΨ0, not_or] bound · apply Set.indicator_le' · intro x hx rw [hΨ1 x |>.mp, Pi.one_apply] simpa using hx · exact fun x _ ↦ (hΨrange x).1 · intro x apply Set.le_indicator_apply · exact fun _ ↦ (hΨrange x).2 · intro hx rw [← hΨ0 x |>.mp] simpa [-not_and, mem_Ioo, not_and_or, not_lt] using hx · ext x simp only [Function.mem_support, ne_eq, mem_Ioo, ← hΨ0, not_or, not_le] lemma SmoothExistence : ∃ (ν : ℝ → ℝ), (ContDiff ℝ ∞ ν) ∧ (∀ x, 0 ≤ ν x) ∧ ν.support ⊆ Icc (1 / 2) 2 ∧ ∫ x in Ici 0, ν x / x = 1 := by suffices h : ∃ (ν : ℝ → ℝ), (ContDiff ℝ ∞ ν) ∧ (∀ x, 0 ≤ ν x) ∧ ν.support ⊆ Set.Icc (1 / 2) 2 ∧ 0 < ∫ x in Set.Ici 0, ν x / x by obtain ⟨ν, hν, hνnonneg, hνsupp, hνpos⟩ := h let c := (∫ x in Ici 0, ν x / x) use fun y ↦ ν y / c refine ⟨hν.div_const c, fun y ↦ div_nonneg (hνnonneg y) (le_of_lt hνpos), ?_, ?_⟩ · rw [Function.support_div, Function.support_const (ne_of_lt hνpos).symm, inter_univ] convert hνsupp · simp only [div_right_comm _ c _, integral_div c, div_self <| ne_of_gt hνpos, c] have := smooth_urysohn_support_Ioo (a := 1 / 2) (b := 1) (c := 3 / 2) (d := 2) (by linarith) (by linarith) obtain ⟨ν, hνContDiff, _, hν0, hν1, hνSupport⟩ := this use ν, hνContDiff unfold indicator at hν0 hν1 simp only [mem_Icc, Pi.one_apply, Pi.le_def, mem_Ioo] at hν0 hν1 simp only [hνSupport, subset_def, mem_Ioo, mem_Icc, and_imp] split_ands · exact fun x ↦ le_trans (by simp [apply_ite]) (hν0 x) · exact fun y hy hy' ↦ ⟨by linarith, by linarith⟩ · rw [integral_pos_iff_support_of_nonneg] · simp only [Function.support_div, measurableSet_Ici, Measure.restrict_apply', hνSupport, Function.support_id'] have : (Ioo (1 / 2 : ℝ) 2 ∩ {0}ᶜ ∩ Ici 0) = Ioo (1 / 2) 2 := by ext x simp only [one_div, mem_inter_iff, mem_Ioo, mem_compl_iff, mem_singleton_iff, mem_Ici] bound simp only [this, volume_Ioo, ENNReal.ofReal_pos, sub_pos, gt_iff_lt] linarith · simp_rw [Pi.le_def, Pi.zero_apply] intro y by_cases h : y ∈ Function.support ν · apply div_nonneg <| le_trans (by simp [apply_ite]) (hν0 y) rw [hνSupport, mem_Ioo] at h linarith [h.left] · simp only [Function.mem_support, ne_eq, not_not] at h simp [h] · have : (fun x ↦ ν x / x).support ⊆ Icc (1 / 2) 2 := by rw [Function.support_div, hνSupport] exact (inter_subset_left).trans Ioo_subset_Icc_self apply (integrableOn_iff_integrable_of_support_subset this).mp apply ContinuousOn.integrableOn_compact isCompact_Icc apply hνContDiff.continuous.continuousOn.div continuousOn_id ?_ simp only [mem_Icc, ne_eq, and_imp, id_eq] intros; linarith end BodyFile025 -- Source: .tools/pnt-port/PrimeNumberTheoremAnd/Wiener.lean section BodyFile026 -- note: the opening of ArithmeticFunction introduces a notation σ that seems -- impossible to hide, and hence parameters that are traditionally called σ will -- have to be called σ' instead in this file. open Real BigOperators ArithmeticFunction MeasureTheory Filter Set FourierTransform LSeries Asymptotics SchwartzMap open Complex hiding log open scoped Topology open scoped ContDiff open scoped ComplexConjugate variable {n : ℕ} {A a b c d u x y t σ' : ℝ} {ψ Ψ : ℝ → ℂ} {F G : ℂ → ℂ} {f : ℕ → ℂ} {𝕜 : Type} [RCLike 𝕜] noncomputable def nterm (f : ℕ → ℂ) (σ' : ℝ) (n : ℕ) : ℝ := if n = 0 then 0 else ‖f n‖ / n ^ σ' lemma nterm_eq_norm_term {f : ℕ → ℂ} : nterm f σ' n = ‖term f σ' n‖ := by by_cases h : n = 0 <;> simp [nterm, term, h] theorem norm_term_eq_nterm_re (s : ℂ) : ‖term f s n‖ = nterm f (s.re) n := by simp only [nterm, term, apply_ite (‖·‖), norm_zero, norm_div] apply ite_congr rfl (fun _ ↦ rfl) intro h congr refine norm_natCast_cpow_of_pos (by omega) s lemma hf_coe1 (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hσ : 1 < σ') : ∑' i, (‖term f σ' i‖₊ : ENNReal) ≠ ⊤ := by simp_rw [ENNReal.tsum_coe_ne_top_iff_summable_coe, ← norm_toNNReal] norm_cast apply Summable.toNNReal convert hf σ' hσ with i simp [nterm_eq_norm_term] abbrev circleMeasurableSpaceDict : MeasurableSpace Circle := inferInstanceAs <| MeasurableSpace <| Subtype _ abbrev circleBorelSpaceDict : letI := circleMeasurableSpaceDict; BorelSpace Circle := letI := circleMeasurableSpaceDict; inferInstanceAs <| BorelSpace <| Subtype (· ∈ Metric.sphere (0 : ℂ) 1) -- TODO - add to mathlib lemma first_fourier_aux1 (hψ : AEMeasurable ψ) {x : ℝ} (n : ℕ) : AEMeasurable fun (u : ℝ) ↦ (‖fourierChar (-(u * ((1 : ℝ) / ((2 : ℝ) * π) * (n / x).log))) • ψ u‖ₑ : ENNReal) := by letI := @circleMeasurableSpaceDict letI := @circleBorelSpaceDict simpa only [enorm_eq_nnnorm, nnnorm_circle_smul] using hψ.nnnorm.coe_nnreal_ennreal lemma first_fourier_aux2a : (2 : ℂ) * π * -(y * (1 / (2 * π) * Real.log ((n) / x))) = -(y * ((n) / x).log) := by calc _ = -(y * (((2 : ℂ) * π) / (2 * π) * Real.log ((n) / x))) := by ring _ = _ := by rw [div_self (by norm_num), one_mul] lemma first_fourier_aux2 (hx : 0 < x) (n : ℕ) : term f σ' n * 𝐞 (-(y * (1 / (2 * π) * Real.log (n / x)))) • ψ y = term f (σ' + y * I) n • (ψ y * x ^ (y * I)) := by by_cases hn : n = 0 · simp [term, hn] simp only [term, hn, ↓reduceIte] calc _ = (f n * (cexp ((2 * π * -(y * (1 / (2 * π) * Real.log (n / x)))) * I) / ↑((n : ℝ) ^ σ'))) • ψ y := by rw [Circle.smul_def, fourierChar_apply, ofReal_cpow (by norm_num)] simp only [one_div, mul_inv_rev, mul_neg, ofReal_neg, ofReal_mul, ofReal_ofNat, ofReal_inv, neg_mul, smul_eq_mul, ofReal_natCast] ring _ = (f n * (x ^ (y * I) / n ^ (σ' + y * I))) • ψ y := by congr 2 have l1 : 0 < (n : ℝ) := by simpa using Nat.pos_iff_ne_zero.mpr hn have l2 : (x : ℂ) ≠ 0 := by simp [hx.ne.symm] have l3 : (n : ℂ) ≠ 0 := by simp [hn] rw [Real.rpow_def_of_pos l1, Complex.cpow_def_of_ne_zero l2, Complex.cpow_def_of_ne_zero l3] push_cast simp_rw [← Complex.exp_sub] congr 1 rw [first_fourier_aux2a, Real.log_div l1.ne.symm hx.ne.symm] push_cast rw [Complex.ofReal_log hx.le] ring _ = _ := by simp ; group lemma first_fourier (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hsupp : Integrable ψ) (hx : 0 < x) (hσ : 1 < σ') : ∑' n : ℕ, term f σ' n * (𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * log (n / x))) = ∫ t : ℝ, LSeries f (σ' + t * I) * ψ t * x ^ (t * I) := by letI := @circleMeasurableSpaceDict letI := @circleBorelSpaceDict calc _ = ∑' n, term f σ' n * ∫ (v : ℝ), 𝐞 (-(v * ((1 : ℝ) / ((2 : ℝ) * π) * Real.log (n / x)))) • ψ v := by simp only [Real.fourier_real_eq] _ = ∑' n, ∫ (v : ℝ), term f σ' n * 𝐞 (-(v * ((1 : ℝ) / ((2 : ℝ) * π) * Real.log (n / x)))) • ψ v := by simp [integral_const_mul] _ = ∫ (v : ℝ), ∑' n, term f σ' n * 𝐞 (-(v * ((1 : ℝ) / ((2 : ℝ) * π) * Real.log (n / x)))) • ψ v := by refine (integral_tsum ?_ ?_).symm · refine fun _ ↦ AEMeasurable.aestronglyMeasurable ?_ have := hsupp.aemeasurable fun_prop · simp only [enorm_mul] simp_rw [lintegral_const_mul'' _ (first_fourier_aux1 hsupp.aemeasurable _)] calc _ = (∑' (i : ℕ), ‖term f σ' i‖ₑ) * ∫⁻ (a : ℝ), ‖ψ a‖ₑ ∂volume := by simp [ENNReal.tsum_mul_right, enorm_eq_nnnorm, nnnorm_circle_smul] _ ≠ ⊤ := ENNReal.mul_ne_top (hf_coe1 hf hσ) (ne_top_of_lt hsupp.2) _ = _ := by congr 1; ext y simp_rw [mul_assoc (LSeries _ _), ← smul_eq_mul (a := (LSeries _ _)), LSeries] rw [← Summable.tsum_smul_const] · simp_rw [first_fourier_aux2 hx] · apply Summable.of_norm convert hf σ' hσ with n rw [norm_term_eq_nterm_re] simp lemma continuous_multiplicative_ofAdd : Continuous (⇑Multiplicative.ofAdd : ℝ → ℝ) := ⟨fun _ ↦ id⟩ lemma second_fourier_integrable_aux1a (hσ : 1 < σ') : IntegrableOn (fun (x : ℝ) ↦ cexp (-((x : ℂ) * ((σ' : ℂ) - 1)))) (Ici (-Real.log x)) := by norm_cast suffices IntegrableOn (fun (x : ℝ) ↦ (rexp (-(x * (σ' - 1))))) (Ici (-x.log)) _ from this.ofReal simp_rw [fun (a x : ℝ) ↦ (by ring : -(x * a) = -a * x)] rw [integrableOn_Ici_iff_integrableOn_Ioi] apply exp_neg_integrableOn_Ioi linarith lemma second_fourier_integrable_aux1 (hcont : Measurable ψ) (hsupp : Integrable ψ) (hσ : 1 < σ') : let ν : Measure (ℝ × ℝ) := (volume.restrict (Ici (-Real.log x))).prod volume Integrable (Function.uncurry fun (u : ℝ) (a : ℝ) ↦ ((rexp (-u * (σ' - 1))) : ℂ) • (𝐞 (Multiplicative.ofAdd (-(a * (u / (2 * π))))) : ℂ) • ψ a) ν := by letI := @circleMeasurableSpaceDict letI := @circleBorelSpaceDict intro ν constructor · apply Measurable.aestronglyMeasurable -- TODO: find out why fun_prop does not play well with Multiplicative.ofAdd simp only [neg_mul, ofReal_exp, ofReal_neg, ofReal_mul, ofReal_sub, ofReal_one, Multiplicative.ofAdd, Equiv.coe_fn_mk, smul_eq_mul] change Measurable (fun p : ℝ × ℝ => cexp (-((p.1 : ℂ) * ((σ' : ℂ) - 1))) * ((Real.fourierChar (-(p.2 * (p.1 / (2 * π)))) : ℂ) * ψ p.2)) fun_prop · let f1 : ℝ → ENNReal := fun a1 ↦ ‖cexp (-(↑a1 * (↑σ' - 1)))‖ₑ let f2 : ℝ → ENNReal := fun a2 ↦ ‖ψ a2‖ₑ suffices ∫⁻ (a : ℝ × ℝ), f1 a.1 * f2 a.2 ∂ν < ⊤ by simpa [hasFiniteIntegral_iff_enorm, enorm_eq_nnnorm, Function.uncurry, nnnorm_eq_of_mem_circle] refine (lintegral_prod_mul ?_ ?_).trans_lt ?_ <;> try fun_prop exact ENNReal.mul_lt_top (second_fourier_integrable_aux1a hσ).2 hsupp.2 lemma second_fourier_integrable_aux2 (hσ : 1 < σ') : IntegrableOn (fun (u : ℝ) ↦ cexp ((1 - ↑σ' - ↑t * I) * ↑u)) (Ioi (-Real.log x)) := by refine (integrable_norm_iff (Measurable.aestronglyMeasurable <| by fun_prop)).mp ?_ suffices IntegrableOn (fun a ↦ rexp (-(σ' - 1) * a)) (Ioi (-x.log)) _ by simpa [Complex.norm_exp] apply exp_neg_integrableOn_Ioi linarith lemma second_fourier_aux (hx : 0 < x) : -(cexp (-((1 - ↑σ' - ↑t * I) * ↑(Real.log x))) / (1 - ↑σ' - ↑t * I)) = ↑(x ^ (σ' - 1)) * (↑σ' + ↑t * I - 1)⁻¹ * ↑x ^ (↑t * I) := by calc _ = cexp (↑(Real.log x) * ((↑σ' - 1) + ↑t * I)) * (↑σ' + ↑t * I - 1)⁻¹ := by rw [← div_neg]; ring_nf _ = (x ^ ((↑σ' - 1) + ↑t * I)) * (↑σ' + ↑t * I - 1)⁻¹ := by rw [Complex.cpow_def_of_ne_zero (ofReal_ne_zero.mpr (ne_of_gt hx)), Complex.ofReal_log hx.le] _ = (x ^ ((σ' : ℂ) - 1)) * (x ^ (↑t * I)) * (↑σ' + ↑t * I - 1)⁻¹ := by rw [Complex.cpow_add _ _ (ofReal_ne_zero.mpr (ne_of_gt hx))] _ = _ := by rw [ofReal_cpow hx.le]; push_cast; ring lemma second_fourier (hcont : Measurable ψ) (hsupp : Integrable ψ) {x σ' : ℝ} (hx : 0 < x) (hσ : 1 < σ') : ∫ u in Ici (-log x), Real.exp (-u * (σ' - 1)) * 𝓕 (ψ : ℝ → ℂ) (u / (2 * π)) = (x^(σ' - 1) : ℝ) * ∫ t, (1 / (σ' + t * I - 1)) * ψ t * x^(t * I) ∂ volume := by have he (r : ℝ) (z : ℂ) : 𝐞 r • z = Complex.exp ((2 * π * r : ℝ) * I) * z := by change (𝐞 r : ℂ) * z = _ rw [Real.fourierChar_apply] conv in ↑(rexp _) * _ => { rw [Real.fourier_real_eq, ← smul_eq_mul, ← integral_smul] } rw [MeasureTheory.integral_integral_swap] swap · exact second_fourier_integrable_aux1 hcont hsupp hσ rw [← integral_const_mul] congr 1; ext t simp_rw [smul_eq_mul, mul_smul_comm, ← smul_mul_assoc, integral_mul_const] rw [fun (a b d : ℂ) ↦ show a * (b * (ψ t) * d) = (a * b * d) * ψ t by ring] congr 1 conv => lhs enter [2] ext a rw [he] push_cast simp_rw [← Complex.exp_add] have (u : ℝ) : 2 * ↑π * -(↑t * (↑u / (2 * ↑π))) * I + -↑u * (↑σ' - 1) = (1 - σ' - t * I) * u := calc _ = -↑u * (↑σ' - 1) + (2 * ↑π) / (2 * ↑π) * -(↑t * ↑u) * I := by ring _ = -↑u * (↑σ' - 1) + 1 * -(↑t * ↑u) * I := by rw [div_self (by norm_num)] _ = _ := by ring simp_rw [this] let c : ℂ := (1 - ↑σ' - ↑t * I) have : c ≠ 0 := by simp [Complex.ext_iff, c, sub_ne_zero.mpr hσ.ne] let f' (u : ℝ) := cexp (c * u) let f := fun (u : ℝ) ↦ (f' u) / c have hderiv : ∀ u ∈ Ici (-Real.log x), HasDerivAt f (f' u) u := by intro u _ rw [show f' u = cexp (c * u) * (c * 1) / c by simp only [f']; field_simp] exact (hasDerivAt_id' u).ofReal_comp.const_mul c |>.cexp.div_const c have hf : Tendsto f atTop (𝓝 0) := by apply tendsto_zero_iff_norm_tendsto_zero.mpr suffices Tendsto (fun (x : ℝ) ↦ ‖cexp (c * ↑x)‖ / ‖c‖) atTop (𝓝 (0 / ‖c‖)) by simpa [f, f'] using this apply Filter.Tendsto.div_const suffices Tendsto (· * (1 - σ')) atTop atBot by simpa [Complex.norm_exp, mul_comm (1 - σ'), c] exact Tendsto.atTop_mul_const_of_neg (by linarith) fun ⦃s⦄ h ↦ h rw [integral_Ici_eq_integral_Ioi, integral_Ioi_of_hasDerivAt_of_tendsto' hderiv (second_fourier_integrable_aux2 hσ) hf] simpa [f, f'] using second_fourier_aux hx lemma one_add_sq_pos (u : ℝ) : 0 < 1 + u ^ 2 := zero_lt_one.trans_le (by simpa using sq_nonneg u) theorem prelim_decay (ψ : ℝ → ℂ) (u : ℝ) : ‖𝓕 (ψ : ℝ → ℂ) u‖ ≤ ∫ t, ‖ψ t‖ := VectorFourier.norm_fourierIntegral_le_integral_norm .. lemma decay_bounds_key : letI := @W1.coeFunDict letI := @W21.normDict ∀ (f : W21) (u : ℝ), ‖𝓕 (f : ℝ → ℂ) u‖ ≤ ‖f‖ * (1 + u ^ 2)⁻¹ := by letI := @W1.coeFunDict letI := @W21.normDict intro f u have l1 : 0 < 1 + u ^ 2 := one_add_sq_pos _ have l2 : 1 + u ^ 2 = ‖(1 : ℂ) + u ^ 2‖ := by norm_cast ; simp only [Real.norm_eq_abs, abs_eq_self.2 l1.le] have l3 : ‖1 / ((4 : ℂ) * ↑π ^ 2)‖ ≤ (4 * π ^ 2)⁻¹ := by simp have key := fourierIntegral_self_add_deriv_deriv f u simp only [Function.iterate_succ _ 1, Function.iterate_one, Function.comp_apply] at key rw [F_sub f.hf (f.hf''.const_mul (1 / (4 * ↑π ^ 2)))] at key rw [← div_eq_mul_inv, le_div_iff₀ l1, mul_comm, l2, ← norm_mul, key, sub_eq_add_neg] apply norm_add_le _ _ |>.trans change _ ≤ W21.norm _ rw [norm_neg, F_mul, norm_mul, W21.norm] gcongr <;> apply VectorFourier.norm_fourierIntegral_le_integral_norm lemma decay_bounds_aux {f : ℝ → ℂ} (hf : AEStronglyMeasurable f volume) (h : ∀ t, ‖f t‖ ≤ A * (1 + t ^ 2)⁻¹) : ∫ t, ‖f t‖ ≤ π * A := by have l1 : Integrable (fun x ↦ A * (1 + x ^ 2)⁻¹) := integrable_inv_one_add_sq.const_mul A simp_rw [← integral_univ_inv_one_add_sq, mul_comm, ← integral_const_mul] exact integral_mono (l1.mono' hf (Eventually.of_forall h)).norm l1 h theorem decay_bounds_W21 : letI := @W1.coeFunDict ∀ (f : W21) (hA : ∀ t, ‖f t‖ ≤ A / (1 + t ^ 2)) (hA' : ∀ t, ‖deriv (deriv f) t‖ ≤ A / (1 + t ^ 2)) (u), ‖𝓕 (f : ℝ → ℂ) u‖ ≤ (π + 1 / (4 * π)) * A / (1 + u ^ 2) := by letI := @W1.coeFunDict intro f hA hA' u have l0 : 1 * (4 * π)⁻¹ * A = (4 * π ^ 2)⁻¹ * (π * A) := by field_simp have l1 : ∫ (v : ℝ), ‖f v‖ ≤ π * A := by apply decay_bounds_aux f.continuous.aestronglyMeasurable simp_rw [← div_eq_mul_inv] ; exact hA have l2 : ∫ (v : ℝ), ‖deriv (deriv f) v‖ ≤ π * A := by apply decay_bounds_aux f.deriv.deriv.continuous.aestronglyMeasurable simp_rw [← div_eq_mul_inv] ; exact hA' apply decay_bounds_key f u |>.trans change W21.norm _ * _ ≤ _ simp_rw [W21.norm, div_eq_mul_inv, add_mul, l0] ; gcongr lemma decay_bounds : letI := @CS.coeFunDict ∀ (ψ : CS 2 ℂ) (hA : ∀ t, ‖ψ t‖ ≤ A / (1 + t ^ 2)) (hA' : ∀ t, ‖deriv^[2] ψ t‖ ≤ A / (1 + t ^ 2)), ‖𝓕 (ψ : ℝ → ℂ) u‖ ≤ (π + 1 / (4 * π)) * A / (1 + u ^ 2) := by letI := @CS.coeFunDict letI := @W1.coeFunDict letI := @W21.csDict intro ψ hA hA' exact decay_bounds_W21 ψ hA hA' u lemma decay_bounds_cor_aux : letI := @CS.coeFunDict ∀ (ψ : CS 2 ℂ), ∃ C : ℝ, ∀ u, ‖ψ u‖ ≤ C / (1 + u ^ 2) := by letI := @CS.coeFunDict letI := @W1.coeFunDict letI := @W21.csDict intro ψ have l1 : HasCompactSupport (fun u : ℝ => ((1 + u ^ 2) : ℝ) * ψ u) := by exact ψ.h2.mul_left have := ψ.h1.continuous obtain ⟨C, hC⟩ := l1.exists_bound_of_continuous (by fun_prop) refine ⟨C, fun u => ?_⟩ specialize hC u simp only [norm_mul, Complex.norm_real, norm_of_nonneg (one_add_sq_pos u).le] at hC rwa [le_div_iff₀' (one_add_sq_pos _)] lemma decay_bounds_cor : letI := @W1.coeFunDict ∀ (ψ : W21), ∃ C : ℝ, ∀ u, ‖𝓕 (ψ : ℝ → ℂ) u‖ ≤ C / (1 + u ^ 2) := by letI := @W1.coeFunDict intro ψ simpa only [div_eq_mul_inv] using ⟨_, decay_bounds_key ψ⟩ lemma continuous_FourierIntegral : letI := @W1.coeFunDict ∀ (ψ : W21), Continuous (𝓕 (ψ : ℝ → ℂ)) := by letI := @W1.coeFunDict intro ψ change Continuous (VectorFourier.fourierIntegral fourierChar volume (innerₗ ℝ) ψ.toFun) exact VectorFourier.fourierIntegral_continuous continuous_fourierChar (by simp only [innerₗ_apply_apply, RCLike.inner_apply', conj_trivial, continuous_mul]) ψ.hf lemma W21.integrable_fourier : letI := @W1.coeFunDict ∀ (ψ : W21) (hc : c ≠ 0), Integrable fun u ↦ 𝓕 (ψ : ℝ → ℂ) (u / c) := by letI := @W1.coeFunDict intro ψ hc have l1 (C) : Integrable (fun u ↦ C / (1 + (u / c) ^ 2)) volume := by simpa using! (integrable_inv_one_add_sq.comp_div hc).const_mul C have l2 : AEStronglyMeasurable (fun u ↦ 𝓕 (ψ : ℝ → ℂ) (u / c)) volume := by exact ((continuous_FourierIntegral ψ).comp (continuous_id.div_const c)).aestronglyMeasurable obtain ⟨C, h⟩ := decay_bounds_cor ψ apply @Integrable.mono' ℝ ℂ _ volume _ _ (fun u => C / (1 + (u / c) ^ 2)) (l1 C) l2 ?_ apply Eventually.of_forall (fun x => h _) lemma continuous_LSeries_aux (hf : Summable (nterm f σ')) : Continuous fun x : ℝ => LSeries f (σ' + x * I) := by have l1 i : Continuous fun x : ℝ ↦ term f (σ' + x * I) i := by by_cases h : i = 0 · simpa [h] using continuous_const · simpa [h] using! continuous_const.div (continuous_const.cpow (by fun_prop) (by simp [h])) (fun x => by simp [h]) have l2 n (x : ℝ) : ‖term f (σ' + x * I) n‖ = nterm f σ' n := by by_cases h : n = 0 · simp [h, nterm] · simp [h, nterm, cpow_add _ _ (Nat.cast_ne_zero.mpr h), Complex.norm_natCast_cpow_of_pos (Nat.pos_of_ne_zero h)] exact continuous_tsum l1 hf (fun n x => le_of_eq (l2 n x)) -- Here compact support is used but perhaps it is not necessary lemma limiting_fourier_aux : letI := @CS.coeFunDict ∀ (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (ψ : CS 2 ℂ) (hx : 1 ≤ x) (σ' : ℝ) (hσ' : 1 < σ'), ∑' n, term f σ' n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * log (n / x)) - A * (x ^ (1 - σ') : ℝ) * ∫ u in Ici (- log x), rexp (-u * (σ' - 1)) * 𝓕 (ψ : ℝ → ℂ) (u / (2 * π)) = ∫ t : ℝ, G (σ' + t * I) * ψ t * x ^ (t * I) := by letI := @CS.coeFunDict letI := @W1.coeFunDict letI := @W21.csDict intro hG' hf ψ hx σ' hσ' have hint : Integrable ψ := ψ.h1.continuous.integrable_of_hasCompactSupport ψ.h2 have l3 : 0 < x := zero_lt_one.trans_le hx have l1 (σ') (hσ' : 1 < σ') := first_fourier hf hint l3 hσ' have l2 (σ') (hσ' : 1 < σ') := second_fourier ψ.h1.continuous.measurable hint l3 hσ' have l8 : Continuous fun t : ℝ ↦ (x : ℂ) ^ (t * I) := continuous_const.cpow (continuous_ofReal.mul continuous_const) (by simp [l3]) have l6 : Continuous fun t : ℝ ↦ LSeries f (↑σ' + ↑t * I) * ψ t * ↑x ^ (↑t * I) := by apply ((continuous_LSeries_aux (hf _ hσ')).mul ψ.h1.continuous).mul l8 have l4 : Integrable fun t : ℝ ↦ LSeries f (↑σ' + ↑t * I) * ψ t * ↑x ^ (↑t * I) := by exact l6.integrable_of_hasCompactSupport ψ.h2.mul_left.mul_right have e2 (u : ℝ) : σ' + u * I - 1 ≠ 0 := by intro h ; have := congr_arg Complex.re h ; simp at this ; linarith have l7 : Continuous fun a ↦ A * ↑(x ^ (1 - σ')) * (↑(x ^ (σ' - 1)) * (1 / (σ' + a * I - 1) * ψ a * x ^ (a * I))) := by simp only [one_div, ← mul_assoc] refine ((continuous_const.mul <| Continuous.inv₀ ?_ e2).mul ψ.h1.continuous).mul l8 fun_prop have l5 : Integrable fun a ↦ A * ↑(x ^ (1 - σ')) * (↑(x ^ (σ' - 1)) * (1 / (σ' + a * I - 1) * ψ a * x ^ (a * I))) := by apply l7.integrable_of_hasCompactSupport exact ψ.h2.mul_left.mul_right.mul_left.mul_left simp_rw [l1 σ' hσ', l2 σ' hσ', ← integral_const_mul, ← integral_sub l4 l5] apply integral_congr_ae apply Eventually.of_forall intro u have e1 : 1 < ((σ' : ℂ) + (u : ℂ) * I).re := by simp [hσ'] simp_rw [hG' e1, sub_mul, ← mul_assoc] simp only [one_div, sub_right_inj, mul_eq_mul_right_iff, cpow_eq_zero_iff, ofReal_eq_zero, ne_eq, mul_eq_zero, I_ne_zero, or_false] left ; left field_simp [e2] norm_cast simp [mul_assoc, ← rpow_add l3] section nabla variable {α E : Type*} [OfNat α 1] [Add α] [Sub α] {u : α → ℂ} def cumsum [AddCommMonoid E] (u : ℕ → E) (n : ℕ) : E := ∑ i ∈ Finset.range n, u i def nabla [Sub E] (u : α → E) (n : α) : E := u (n + 1) - u n /- `nnabla` is the backward difference `u n - u (n+1)`; kept alongside `nabla` for summation-by-parts identities that prefer that orientation. -/ def nnabla [Sub E] (u : α → E) (n : α) : E := u n - u (n + 1) def shift (u : α → E) (n : α) : E := u (n + 1) lemma cumsum_zero [AddCommMonoid E] {u : ℕ → E} : cumsum u 0 = 0 := by simp [cumsum] lemma cumsum_succ [AddCommMonoid E] {u : ℕ → E} (n : ℕ) : cumsum u (n + 1) = cumsum u n + u n := by simp [cumsum, Finset.sum_range_succ] lemma nabla_cumsum [AddCommGroup E] {u : ℕ → E} : nabla (cumsum u) = u := by ext n ; simp [nabla, cumsum, Finset.range_add_one] lemma neg_cumsum [AddCommGroup E] {u : ℕ → E} : -(cumsum u) = cumsum (-u) := funext (fun n => by simp [cumsum]) lemma cumsum_nonneg {u : ℕ → ℝ} (hu : 0 ≤ u) : 0 ≤ cumsum u := fun _ => Finset.sum_nonneg (fun i _ => hu i) omit [Sub α] in lemma neg_nabla [Ring E] {u : α → E} : -(nabla u) = nnabla u := by ext n ; simp [nabla, nnabla] omit [Sub α] in lemma nabla_mul [Ring E] {u : α → E} {c : E} : nabla (fun n => c * u n) = c • nabla u := by ext n ; simp [nabla, mul_sub] omit [Sub α] in lemma nnabla_mul [Ring E] {u : α → E} {c : E} : nnabla (fun n => c * u n) = c • nnabla u := by ext n ; simp [nnabla, mul_sub] lemma nnabla_cast (u : ℝ → E) [Sub E] : nnabla u ∘ ((↑) : ℕ → ℝ) = nnabla (u ∘ (↑)) := by ext n ; simp [nnabla] end nabla lemma Finset.sum_shift_front {E : Type*} [Ring E] {u : ℕ → E} {n : ℕ} : cumsum u (n + 1) = u 0 + cumsum (shift u) n := by simp_rw [add_comm n, cumsum, sum_range_add, sum_range_one, add_comm 1] ; rfl lemma Finset.sum_shift_front' {E : Type*} [Ring E] {u : ℕ → E} : shift (cumsum u) = (fun _ => u 0) + cumsum (shift u) := by ext n ; apply Finset.sum_shift_front lemma Finset.sum_shift_back {E : Type*} [Ring E] {u : ℕ → E} {n : ℕ} : cumsum u (n + 1) = cumsum u n + u n := by simp [cumsum, Finset.range_add_one, add_comm] lemma Finset.sum_shift_back' {E : Type*} [Ring E] {u : ℕ → E} : shift (cumsum u) = cumsum u + u := by ext n ; apply Finset.sum_shift_back lemma summation_by_parts {E : Type*} [Ring E] {a A b : ℕ → E} (ha : a = nabla A) {n : ℕ} : cumsum (a * b) (n + 1) = A (n + 1) * b n - A 0 * b 0 - cumsum (shift A * fun i => (b (i + 1) - b i)) n := by have l1 : ∑ x ∈ Finset.range (n + 1), A (x + 1) * b x = ∑ x ∈ Finset.range n, A (x + 1) * b x + A (n + 1) * b n := Finset.sum_shift_back have l2 : ∑ x ∈ Finset.range (n + 1), A x * b x = A 0 * b 0 + ∑ x ∈ Finset.range n, A (x + 1) * b (x + 1) := Finset.sum_shift_front simp only [cumsum, ha, Pi.mul_apply, nabla, sub_mul, Finset.sum_sub_distrib, l1, l2, shift, mul_sub] abel lemma summation_by_parts' {E : Type*} [Ring E] {a b : ℕ → E} {n : ℕ} : cumsum (a * b) (n + 1) = cumsum a (n + 1) * b n - cumsum (shift (cumsum a) * nabla b) n := by simpa [cumsum_zero] using! summation_by_parts (a := a) (b := b) (A := cumsum a) nabla_cumsum.symm lemma summation_by_parts'' {E : Type*} [Ring E] {a b : ℕ → E} : shift (cumsum (a * b)) = shift (cumsum a) * b - cumsum (shift (cumsum a) * nabla b) := by ext n ; apply summation_by_parts' lemma summable_iff_bounded {u : ℕ → ℝ} (hu : 0 ≤ u) : Summable u ↔ BoundedAtFilter atTop (cumsum u) := by have l1 : (cumsum u =O[atTop] 1) ↔ _ := isBigO_one_nat_atTop_iff have l2 n : ‖cumsum u n‖ = cumsum u n := by simpa using cumsum_nonneg hu n simp only [BoundedAtFilter, l1, l2] constructor <;> intro ⟨C, h1⟩ · exact ⟨C, fun n => sum_le_hasSum _ (fun i _ => hu i) h1⟩ · exact summable_of_sum_range_le hu h1 lemma Filter.EventuallyEq.summable {u v : ℕ → ℝ} (h : u =ᶠ[atTop] v) (hu : Summable v) : Summable u := summable_of_isBigO_nat hu h.isBigO lemma summable_congr_ae {u v : ℕ → ℝ} (huv : u =ᶠ[atTop] v) : Summable u ↔ Summable v := by constructor <;> intro h <;> simp [huv.summable, huv.symm.summable, h] lemma BoundedAtFilter.add_const {u : ℕ → ℝ} {c : ℝ} : BoundedAtFilter atTop (fun n => u n + c) ↔ BoundedAtFilter atTop u := by have : u = fun n => (u n + c) + (-c) := by ext n ; ring simp only [BoundedAtFilter] constructor <;> intro h on_goal 1 => rw [this] all_goals { exact h.add (const_boundedAtFilter _ _) } lemma BoundedAtFilter.comp_add {u : ℕ → ℝ} {N : ℕ} : BoundedAtFilter atTop (fun n => u (n + N)) ↔ BoundedAtFilter atTop u := by simp only [BoundedAtFilter, isBigO_iff, norm_eq_abs, Pi.one_apply, eventually_atTop] constructor <;> intro ⟨C, n₀, h⟩ <;> use C · refine ⟨n₀ + N, fun n hn => ?_⟩ obtain ⟨k, rfl⟩ := Nat.exists_eq_add_of_le' (m := N) (n := n) (by grind) exact h _ <| Nat.add_le_add_iff_right.mp hn · exact ⟨n₀, fun n hn => h _ (by grind)⟩ lemma summable_iff_bounded' {u : ℕ → ℝ} (hu : ∀ᶠ n in atTop, 0 ≤ u n) : Summable u ↔ BoundedAtFilter atTop (cumsum u) := by obtain ⟨N, hu⟩ := eventually_atTop.mp hu have e2 : cumsum (fun i ↦ u (i + N)) = fun n => cumsum u (n + N) - cumsum u N := by ext n ; simp_rw [cumsum, add_comm _ N, Finset.sum_range_add] ; ring rw [← summable_nat_add_iff N, summable_iff_bounded (fun n => hu _ <| Nat.le_add_left N n), e2] simp_rw [sub_eq_add_neg, BoundedAtFilter.add_const, BoundedAtFilter.comp_add] lemma bounded_of_shift {u : ℕ → ℝ} (h : BoundedAtFilter atTop (shift u)) : BoundedAtFilter atTop u := by simp only [BoundedAtFilter, isBigO_iff, eventually_atTop] at h ⊢ obtain ⟨C, N, hC⟩ := h refine ⟨C, N + 1, fun n hn => ?_⟩ simp only [shift] at hC have r1 : n - 1 ≥ N := Nat.le_sub_one_of_lt hn have r2 : n - 1 + 1 = n := Nat.sub_add_cancel (by omega) simpa [r2] using hC (n - 1) r1 lemma dirichlet_test' {a b : ℕ → ℝ} (ha : 0 ≤ a) (hb : 0 ≤ b) (hAb : BoundedAtFilter atTop (shift (cumsum a) * b)) (hbb : ∀ᶠ n in atTop, b (n + 1) ≤ b n) (h : Summable (shift (cumsum a) * nnabla b)) : Summable (a * b) := by have l1 : ∀ᶠ n in atTop, 0 ≤ (shift (cumsum a) * nnabla b) n := by filter_upwards [hbb] with n hb exact mul_nonneg (by simpa [shift] using! Finset.sum_nonneg' ha) (sub_nonneg.mpr hb) rw [summable_iff_bounded (mul_nonneg ha hb)] rw [summable_iff_bounded' l1] at h apply bounded_of_shift simpa only [summation_by_parts'', sub_eq_add_neg, neg_cumsum, ← mul_neg, neg_nabla] using hAb.add h lemma exists_antitone_of_eventually {u : ℕ → ℝ} (hu : ∀ᶠ n in atTop, u (n + 1) ≤ u n) : ∃ v : ℕ → ℝ, range v ⊆ range u ∧ Antitone v ∧ v =ᶠ[atTop] u := by obtain ⟨N, hN⟩ := eventually_atTop.mp hu let v (n : ℕ) := u (if n < N then N else n) refine ⟨v, ?_, ?_, ?_⟩ · exact fun x ⟨n, hn⟩ => ⟨if n < N then N else n, hn⟩ · refine antitone_nat_of_succ_le (fun n => ?_) by_cases h : n < N · by_cases h' : n + 1 < N <;> simp [v, h, h'] have : n + 1 = N := by linarith simp [this] · have : ¬(n + 1 < N) := by linarith simp only [this, ↓reduceIte, h, ge_iff_le, v] ; apply hN ; linarith · have : ∀ᶠ n in atTop, ¬(n < N) := by simpa using ⟨N, fun b hb => by linarith⟩ filter_upwards [this] with n hn ; simp [v, hn] lemma summable_inv_mul_log_sq : Summable (fun n : ℕ => (n * (Real.log n) ^ 2)⁻¹) := by let u (n : ℕ) := (n * (Real.log n) ^ 2)⁻¹ have l7 : ∀ᶠ n : ℕ in atTop, 1 ≤ Real.log n := tendsto_atTop.mp (tendsto_log_atTop.comp tendsto_natCast_atTop_atTop) 1 have l8 : ∀ᶠ n : ℕ in atTop, 1 ≤ n := eventually_ge_atTop 1 have l9 : ∀ᶠ n in atTop, u (n + 1) ≤ u n := by filter_upwards [l7, l8] with n l2 l8; dsimp [u]; gcongr <;> simp obtain ⟨v, l1, l2, l3⟩ := exists_antitone_of_eventually l9 rw [summable_congr_ae l3.symm] have l4 (n : ℕ) : 0 ≤ v n := by obtain ⟨k, hk⟩ := l1 ⟨n, rfl⟩ ; rw [← hk] ; positivity apply (summable_condensed_iff_of_nonneg l4 (fun _ _ _ a ↦ l2 a)).mp suffices this : ∀ᶠ k : ℕ in atTop, 2 ^ k * v (2 ^ k) = ((k : ℝ) ^ 2)⁻¹ * ((Real.log 2) ^ 2)⁻¹ by exact (summable_congr_ae this).mpr <| (Real.summable_nat_pow_inv.mpr one_lt_two).mul_right _ have l5 : ∀ᶠ k in atTop, v (2 ^ k) = u (2 ^ k) := l3.comp_tendsto <| tendsto_pow_atTop_atTop_of_one_lt Nat.le.refl filter_upwards [l5, l8] with k l5 l8 simp only [l5, mul_inv_rev, Nat.cast_pow, Nat.cast_ofNat, log_pow, u] field_simp lemma tendsto_mul_add_atTop {a : ℝ} (ha : 0 < a) (b : ℝ) : Tendsto (fun x => a * x + b) atTop atTop := tendsto_atTop_add_const_right _ b (tendsto_id.const_mul_atTop ha) lemma isLittleO_const_of_tendsto_atTop {α : Type*} [Preorder α] (a : ℝ) {f : α → ℝ} (hf : Tendsto f atTop atTop) : (fun _ => a) =o[atTop] f := by simp [tendsto_norm_atTop_atTop.comp hf] lemma isBigO_pow_pow_of_le {m n : ℕ} (h : m ≤ n) : (fun x : ℝ => x ^ m) =O[atTop] (fun x : ℝ => x ^ n) := by apply IsBigO.of_bound 1 filter_upwards [eventually_ge_atTop 1] with x l1 simpa [abs_eq_self.mpr (zero_le_one.trans l1)] using pow_le_pow_right₀ l1 h lemma isLittleO_mul_add_sq (a b : ℝ) : (fun x => a * x + b) =o[atTop] (fun x => x ^ 2) := by apply IsLittleO.add · apply IsLittleO.const_mul_left ; simpa using isLittleO_pow_pow_atTop_of_lt (𝕜 := ℝ) one_lt_two · apply isLittleO_const_of_tendsto_atTop _ <| tendsto_pow_atTop (by linarith) lemma log_mul_add_isBigO_log {a : ℝ} (ha : 0 < a) (b : ℝ) : (fun x => Real.log (a * x + b)) =O[atTop] Real.log := by apply IsBigO.of_bound (2 : ℕ) have l2 : ∀ᶠ x : ℝ in atTop, 0 ≤ log x := tendsto_atTop.mp tendsto_log_atTop 0 have l3 : ∀ᶠ x : ℝ in atTop, 0 ≤ log (a * x + b) := tendsto_atTop.mp (tendsto_log_atTop.comp (tendsto_mul_add_atTop ha b)) 0 have l5 : ∀ᶠ x : ℝ in atTop, 1 ≤ a * x + b := tendsto_atTop.mp (tendsto_mul_add_atTop ha b) 1 have l1 : ∀ᶠ x : ℝ in atTop, a * x + b ≤ x ^ 2 := by filter_upwards [(isLittleO_mul_add_sq a b).eventuallyLE, l5] with x r2 l5 simpa [abs_eq_self.mpr (zero_le_one.trans l5)] using r2 filter_upwards [l1, l2, l3, l5] with x l1 l2 l3 l5 simpa [abs_eq_self.mpr l2, abs_eq_self.mpr l3, Real.log_pow] using Real.log_le_log (by linarith) l1 lemma isBigO_log_mul_add {a : ℝ} (ha : 0 < a) (b : ℝ) : Real.log =O[atTop] (fun x => Real.log (a * x + b)) := by convert! (log_mul_add_isBigO_log (b := -b / a) (inv_pos.mpr ha)).comp_tendsto (tendsto_mul_add_atTop (b := b) ha) using 1 ext x simp only [Function.comp_apply] congr field_simp simp lemma log_isbigo_log_div {d : ℝ} (hb : 0 < d) : (fun n ↦ Real.log n) =O[atTop] (fun n ↦ Real.log (n / d)) := by convert isBigO_log_mul_add (inv_pos.mpr hb) 0 using 1; simp only [add_zero]; field_simp lemma Asymptotics.IsBigO.add_isLittleO_right {f g : ℝ → ℝ} (h : g =o[atTop] f) : f =O[atTop] (f + g) := by rw [isLittleO_iff] at h ; specialize h (c := 2⁻¹) (by norm_num) rw [isBigO_iff''] refine ⟨2⁻¹, by norm_num, ?_⟩ filter_upwards [h] with x h simp only [norm_eq_abs, Pi.add_apply] at h ⊢ calc _ = |f x| - 2⁻¹ * |f x| := by ring _ ≤ |f x| - |g x| := by linarith _ ≤ |(|f x| - |g x|)| := le_abs_self _ _ ≤ _ := by rw [← sub_neg_eq_add, ← abs_neg (g x)] ; exact abs_abs_sub_abs_le (f x) (-g x) lemma Asymptotics.IsBigO.sq {α : Type*} [Preorder α] {f g : α → ℝ} (h : f =O[atTop] g) : (fun n ↦ f n ^ 2) =O[atTop] (fun n => g n ^ 2) := by simpa [pow_two] using h.mul h lemma log_sq_isbigo_mul {a b : ℝ} (hb : 0 < b) : (fun x ↦ Real.log x ^ 2) =O[atTop] (fun x ↦ a + Real.log (x / b) ^ 2) := by apply (log_isbigo_log_div hb).sq.trans ; simp_rw [add_comm a] refine IsBigO.add_isLittleO_right <| isLittleO_const_of_tendsto_atTop _ ?_ exact (tendsto_pow_atTop two_ne_zero).comp <| tendsto_log_atTop.comp <| tendsto_id.atTop_div_const hb theorem log_add_div_isBigO_log (a : ℝ) {b : ℝ} (hb : 0 < b) : (fun x ↦ Real.log ((x + a) / b)) =O[atTop] fun x ↦ Real.log x := by convert log_mul_add_isBigO_log (inv_pos.mpr hb) (a / b) using 3 ; ring lemma log_add_one_sub_log_le {x : ℝ} (hx : 0 < x) : nabla Real.log x ≤ x⁻¹ := by have l1 : ContinuousOn Real.log (Icc x (x + 1)) := by apply continuousOn_log.mono ; intro t ⟨h1, _⟩ ; simp ; linarith have l2 t (ht : t ∈ Ioo x (x + 1)) : HasDerivAt Real.log t⁻¹ t := Real.hasDerivAt_log (by linarith [ht.1]) obtain ⟨t, ⟨ht1, _⟩, htx⟩ := exists_hasDerivAt_eq_slope Real.log (·⁻¹) (by linarith) l1 l2 simp only [add_sub_cancel_left, div_one] at htx rw [nabla, ← htx, inv_le_inv₀ (by linarith) hx] exact ht1.le lemma nabla_log_main : nabla Real.log =O[atTop] fun x ↦ 1 / x := by apply IsBigO.of_bound 1 filter_upwards [eventually_gt_atTop 0] with x l1 have l2 : log x ≤ log (x + 1) := log_le_log l1 (by linarith) simpa [nabla, abs_eq_self.mpr l1.le, abs_eq_self.mpr (sub_nonneg.mpr l2)] using log_add_one_sub_log_le l1 lemma nabla_log {b : ℝ} (hb : 0 < b) : nabla (fun x => Real.log (x / b)) =O[atTop] (fun x => 1 / x) := by refine EventuallyEq.trans_isBigO ?_ nabla_log_main filter_upwards [eventually_gt_atTop 0] with x l2 rw [nabla, log_div (by linarith) (by linarith), log_div l2.ne.symm (by linarith), nabla] ; ring lemma nnabla_mul_log_sq (a : ℝ) {b : ℝ} (hb : 0 < b) : nabla (fun x => x * (a + Real.log (x / b) ^ 2)) =O[atTop] (fun x => Real.log x ^ 2) := by have l1 : nabla (fun n => n * (a + Real.log (n / b) ^ 2)) = fun n => a + Real.log ((n + 1) / b) ^ 2 + (n * (Real.log ((n + 1) / b) ^ 2 - Real.log (n / b) ^ 2)) := by ext n ; simp [nabla] ; ring have l2 := (isLittleO_const_of_tendsto_atTop a ((tendsto_pow_atTop two_ne_zero).comp tendsto_log_atTop)).isBigO have l3 := (log_add_div_isBigO_log 1 hb).sq have l4 : (fun x => Real.log ((x + 1) / b) + Real.log (x / b)) =O[atTop] Real.log := by simpa using (log_add_div_isBigO_log _ hb).add (log_add_div_isBigO_log 0 hb) have e2 : (fun x : ℝ => x * (Real.log x * (1 / x))) =ᶠ[atTop] Real.log := by filter_upwards [eventually_ge_atTop 1] with x hx using by field_simp have l5 : (fun n ↦ n * (Real.log n * (1 / n))) =O[atTop] (fun n ↦ (Real.log n) ^ 2) := e2.trans_isBigO (by simpa using! (isLittleO_mul_add_sq 1 0).isBigO.comp_tendsto Real.tendsto_log_atTop) simp_rw [l1, _root_.sq_sub_sq] exact ((l2.add l3).add (isBigO_refl (·) atTop |>.mul (l4.mul (nabla_log hb)) |>.trans l5)) lemma nnabla_bound_aux1 (a : ℝ) {b : ℝ} (hb : 0 < b) : Tendsto (fun x => x * (a + Real.log (x / b) ^ 2)) atTop atTop := tendsto_id.atTop_mul_atTop₀ <| tendsto_atTop_add_const_left _ _ <| (tendsto_pow_atTop two_ne_zero).comp <| tendsto_log_atTop.comp <| tendsto_id.atTop_div_const hb lemma nnabla_bound_aux2 (a : ℝ) {b : ℝ} (hb : 0 < b) : ∀ᶠ x in atTop, 0 < x * (a + Real.log (x / b) ^ 2) := (nnabla_bound_aux1 a hb).eventually (eventually_gt_atTop 0) lemma Real.log_eventually_gt_atTop (a : ℝ) : ∀ᶠ x in atTop, a < Real.log x := Real.tendsto_log_atTop.eventually (eventually_gt_atTop a) /-- Should this be a gcongr lemma? -/ theorem norm_lt_norm_of_nonneg (x y : ℝ) (hx : 0 ≤ x) (hxy : x ≤ y) : ‖x‖ ≤ ‖y‖ := by simp_rw [Real.norm_eq_abs] apply abs_le_abs hxy linarith lemma nnabla_bound_aux {x : ℝ} (hx : 0 < x) : nnabla (fun n ↦ 1 / (n * ((2 * π) ^ 2 + Real.log (n / x) ^ 2))) =O[atTop] (fun n ↦ 1 / (Real.log n ^ 2 * n ^ 2)) := by let d n : ℝ := n * ((2 * π) ^ 2 + Real.log (n / x) ^ 2) change (fun x_1 ↦ nnabla (fun n ↦ 1 / d n) x_1) =O[atTop] _ have l2 : ∀ᶠ n in atTop, 0 < d n := (nnabla_bound_aux2 ((2 * π) ^ 2) hx) have l3 : ∀ᶠ n in atTop, 0 < d (n + 1) := (tendsto_atTop_add_const_right atTop (1 : ℝ) tendsto_id).eventually l2 have l1 : ∀ᶠ n : ℝ in atTop, nnabla (fun n ↦ 1 / d n) n = (d (n + 1) - d n) * (d n)⁻¹ * (d (n + 1))⁻¹ := by filter_upwards [l2, l3] with n l2 l3 rw [nnabla, one_div, one_div, inv_sub_inv l2.ne.symm l3.ne.symm, div_eq_mul_inv, mul_inv, mul_assoc] have l4 : (fun n => (d n)⁻¹) =O[atTop] (fun n => (n * (Real.log n) ^ 2)⁻¹) := by apply IsBigO.inv_rev · refine (isBigO_refl _ _).mul <| (log_sq_isbigo_mul hx) · filter_upwards [Real.log_eventually_gt_atTop 0, eventually_gt_atTop 0] with x hx hx' rw [← not_imp_not] intro _ positivity have l5 : (fun n => (d (n + 1))⁻¹) =O[atTop] (fun n => (n * (Real.log n) ^ 2)⁻¹) := by refine IsBigO.trans ?_ l4 rw [isBigO_iff]; use 1 have e3 : ∀ᶠ n in atTop, d n ≤ d (n + 1) := by filter_upwards [eventually_ge_atTop x] with n hn have e2 : 1 ≤ n / x := (one_le_div hx).mpr hn have : 0 ≤ n := hx.le.trans hn simp only [d] gcongr <;> simp [Real.log_nonneg, *] filter_upwards [l2, l3, e3] with n e1 e2 e3 simp_rw [one_mul] exact norm_lt_norm_of_nonneg _ _ (inv_nonneg.mpr e2.le) ((inv_le_inv₀ e2 e1).mpr e3) have l6 : (fun n => d (n + 1) - d n) =O[atTop] (fun n => (Real.log n) ^ 2) := by simpa [d, nabla] using! (nnabla_mul_log_sq ((2 * π) ^ 2) hx) apply EventuallyEq.trans_isBigO l1 apply ((l6.mul l4).mul l5).trans_eventuallyEq filter_upwards [eventually_ge_atTop 2, Real.log_eventually_gt_atTop 0] with n hn hn' field_simp lemma nnabla_bound (C : ℝ) {x : ℝ} (hx : 0 < x) : nnabla (fun n => C / (1 + (Real.log (n / x) / (2 * π)) ^ 2) / n) =O[atTop] (fun n => (n ^ 2 * (Real.log n) ^ 2)⁻¹) := by field_simp simp only [div_eq_mul_inv, mul_inv, nnabla_mul, one_mul] apply IsBigO.const_mul_left simpa [div_eq_mul_inv, mul_pow, mul_comm] using nnabla_bound_aux hx def chebyWith (C : ℝ) (f : ℕ → ℂ) : Prop := ∀ n, cumsum (‖f ·‖) n ≤ C * n def cheby (f : ℕ → ℂ) : Prop := ∃ C, chebyWith C f lemma cheby.bigO (h : cheby f) : cumsum (‖f ·‖) =O[atTop] ((↑) : ℕ → ℝ) := by have l1 : 0 ≤ cumsum (‖f ·‖) := cumsum_nonneg (fun _ => norm_nonneg _) obtain ⟨C, hC⟩ := h apply isBigO_of_le' (c := C) atTop intro n rw [Real.norm_eq_abs, abs_eq_self.mpr (l1 n)] simpa using hC n lemma limiting_fourier_lim1_aux (hcheby : cheby f) (hx : 0 < x) (C : ℝ) (hC : 0 ≤ C) : Summable fun n ↦ ‖f n‖ / ↑n * (C / (1 + (1 / (2 * π) * Real.log (↑n / x)) ^ 2)) := by let a (n : ℕ) := (C / (1 + (Real.log (↑n / x) / (2 * π)) ^ 2) / ↑n) replace hcheby := hcheby.bigO have l1 : shift (cumsum (‖f ·‖)) =O[atTop] (fun n : ℕ => (↑(n + 1) : ℝ)) := hcheby.comp_tendsto <| tendsto_add_atTop_nat 1 have l2 : shift (cumsum (‖f ·‖)) =O[atTop] (fun n => (n : ℝ)) := l1.trans (by simpa using (isBigO_refl _ _).add <| isBigO_iff.mpr ⟨1, by simpa using ⟨1, by tauto⟩⟩) have l5 : BoundedAtFilter atTop (fun n : ℕ => C / (1 + (Real.log (↑n / x) / (2 * π)) ^ 2)) := by simp only [BoundedAtFilter] field_simp apply isBigO_of_le' (c := C) ; intro n have : 0 ≤ 2 ^ 2 * π ^ 2 + Real.log (n / x) ^ 2 := by positivity simp only [norm_div, norm_mul, norm_eq_abs, abs_eq_self.mpr hC, norm_pow, abs_eq_self.mpr pi_nonneg, abs_eq_self.mpr this, Pi.one_apply, one_mem, CStarRing.norm_of_mem_unitary, mul_one, ge_iff_le, Nat.abs_ofNat] apply div_le_of_le_mul₀ this hC rw [mul_add, ← mul_assoc] apply le_add_of_le_of_nonneg le_rfl positivity have l3 : a =O[atTop] (fun n => 1 / (n : ℝ)) := by simpa [a] using! IsBigO.mul l5 (isBigO_refl (fun n : ℕ => 1 / (n : ℝ)) _) have l4 : nnabla a =O[atTop] (fun n : ℕ => (n ^ 2 * (Real.log n) ^ 2)⁻¹) := by convert (nnabla_bound C hx).natCast ; simp [nnabla, a] simp_rw [div_mul_eq_mul_div, mul_div_assoc, one_mul] apply dirichlet_test' · intro n ; exact norm_nonneg _ · intro n ; positivity · apply (l2.mul l3).trans_eventuallyEq apply eventually_of_mem (Ici_mem_atTop 1) intro x (hx : 1 ≤ x) have : x ≠ 0 := Nat.one_le_iff_ne_zero.mp hx simp [this] · have : ∀ᶠ n : ℕ in atTop, x ≤ n := by simpa using eventually_ge_atTop ⌈x⌉₊ filter_upwards [this] with n hn have e1 : 0 < (n : ℝ) := by linarith have e2 : 1 ≤ n / x := (one_le_div hx).mpr hn have e3 := Nat.le_succ n gcongr refine div_nonneg (Real.log_nonneg e2) (by norm_num [pi_nonneg]) · apply summable_of_isBigO_nat summable_inv_mul_log_sq apply (l2.mul l4).trans_eventuallyEq apply eventually_of_mem (Ici_mem_atTop 2) intro x (hx : 2 ≤ x) have : (x : ℝ) ≠ 0 := by simp ; linarith have : Real.log x ≠ 0 := by have ll : 2 ≤ (x : ℝ) := by simp [hx] simp grind field_simp theorem limiting_fourier_lim1 : letI := @W1.coeFunDict ∀ (hcheby : cheby f) (ψ : W21) (hx : 0 < x), Tendsto (fun σ' : ℝ ↦ ∑' n, term f σ' n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * Real.log (n / x))) (𝓝[>] 1) (𝓝 (∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * Real.log (n / x)))) := by letI := @W1.coeFunDict intro hcheby ψ hx obtain ⟨C, hC⟩ := decay_bounds_cor ψ have : 0 ≤ C := by simpa using (norm_nonneg _).trans (hC 0) refine tendsto_tsum_of_dominated_convergence (limiting_fourier_lim1_aux hcheby hx C this) (fun n => ?_) ?_ · apply Tendsto.mul_const by_cases h : n = 0 <;> simp only [term, h, ↓reduceIte, CharP.cast_eq_zero, div_zero, tendsto_const_nhds_iff] refine tendsto_const_nhds.div ?_ (by simp [h]) simpa using ((continuous_ofReal.tendsto 1).mono_left nhdsWithin_le_nhds).const_cpow · rw [eventually_nhdsWithin_iff] apply Eventually.of_forall intro σ' (hσ' : 1 < σ') n rw [norm_mul, ← nterm_eq_norm_term] refine mul_le_mul ?_ (hC _) (norm_nonneg _) (div_nonneg (norm_nonneg _) (Nat.cast_nonneg _)) by_cases h : n = 0 <;> simp only [nterm, h, ↓reduceIte, CharP.cast_eq_zero, div_zero, le_refl] have : 1 ≤ (n : ℝ) := by simpa using! Nat.pos_iff_ne_zero.mpr h refine div_le_div₀ (norm_nonneg _) le_rfl (by simpa [Nat.pos_iff_ne_zero]) ?_ simpa using Real.rpow_le_rpow_of_exponent_le this hσ'.le theorem limiting_fourier_lim2_aux (x : ℝ) (C : ℝ) : Integrable (fun t ↦ max |x| 1 * (C / (1 + (t / (2 * π)) ^ 2))) (Measure.restrict volume (Ici (-Real.log x))) := by simp_rw [div_eq_mul_inv C] exact (((integrable_inv_one_add_sq.comp_div (by simp [pi_ne_zero])).const_mul _).const_mul _).restrict theorem limiting_fourier_lim2 : letI := @W1.coeFunDict ∀ (A : ℝ) (ψ : W21) (hx : 1 ≤ x), Tendsto (fun σ' ↦ A * ↑(x ^ (1 - σ')) * ∫ u in Ici (-Real.log x), rexp (-u * (σ' - 1)) * 𝓕 (ψ : ℝ → ℂ) (u / (2 * π))) (𝓝[>] 1) (𝓝 (A * ∫ u in Ici (-Real.log x), 𝓕 (ψ : ℝ → ℂ) (u / (2 * π)))) := by letI := @W1.coeFunDict intro A ψ hx obtain ⟨C, hC⟩ := decay_bounds_cor ψ apply Tendsto.mul · suffices h : Tendsto (fun σ' : ℝ ↦ ofReal (x ^ (1 - σ'))) (𝓝[>] 1) (𝓝 1) by simpa using h.const_mul ↑A suffices h : Tendsto (fun σ' : ℝ ↦ x ^ (1 - σ')) (𝓝[>] 1) (𝓝 1) from (continuous_ofReal.tendsto 1).comp h have : Tendsto (fun σ' : ℝ ↦ σ') (𝓝 1) (𝓝 1) := fun _ a ↦ a have : Tendsto (fun σ' : ℝ ↦ 1 - σ') (𝓝[>] 1) (𝓝 0) := tendsto_nhdsWithin_of_tendsto_nhds (by simpa using this.const_sub 1) simpa using tendsto_const_nhds.rpow this (Or.inl (zero_lt_one.trans_le hx).ne.symm) · refine tendsto_integral_filter_of_dominated_convergence _ ?_ ?_ (limiting_fourier_lim2_aux x C) ?_ · apply Eventually.of_forall ; intro σ' apply Continuous.aestronglyMeasurable have := continuous_FourierIntegral ψ continuity · apply eventually_of_mem (U := Ioo 1 2) · apply Ioo_mem_nhdsGT_of_mem ; simp · intro σ' ⟨h1, h2⟩ rw [ae_restrict_iff' measurableSet_Ici] apply Eventually.of_forall intro t (ht : - Real.log x ≤ t) rw [norm_mul] have hdom_nonneg : 0 ≤ max |x| 1 := by exact (abs_nonneg x).trans (le_max_left _ _) refine mul_le_mul ?_ (hC _) (norm_nonneg _) hdom_nonneg simp only [neg_mul, ofReal_exp, ofReal_neg, ofReal_mul, ofReal_sub, ofReal_one, norm_exp, neg_re, mul_re, ofReal_re, sub_re, one_re, ofReal_im, sub_im, one_im, sub_self, mul_zero, sub_zero] have : -Real.log x * (σ' - 1) ≤ t * (σ' - 1) := mul_le_mul_of_nonneg_right ht (by linarith) have : -(t * (σ' - 1)) ≤ Real.log x * (σ' - 1) := by simpa using neg_le_neg this have := Real.exp_monotone this apply this.trans have l1 : σ' - 1 ≤ 1 := by linarith have : 0 ≤ Real.log x := Real.log_nonneg hx have := mul_le_mul_of_nonneg_left l1 this refine (Real.exp_monotone this).trans ?_ have hxabs : |x| = x := abs_of_nonneg (zero_le_one.trans hx) calc Real.exp (Real.log x * 1) = |x| := by simpa [mul_one, hxabs] using (Real.exp_log (zero_lt_one.trans_le hx)) _ ≤ max |x| 1 := le_max_left _ _ · apply Eventually.of_forall intro x suffices h : Tendsto (fun n ↦ ((rexp (-x * (n - 1))) : ℂ)) (𝓝[>] 1) (𝓝 1) by simpa using h.mul_const _ apply Tendsto.mono_left ?_ nhdsWithin_le_nhds suffices h : Continuous (fun n ↦ ((rexp (-x * (n - 1))) : ℂ)) by simpa using h.tendsto 1 continuity theorem limiting_fourier_lim3 : letI := @CS.coeFunDict ∀ (hG : ContinuousOn G {s | 1 ≤ s.re}) (ψ : CS 2 ℂ) (hx : 1 ≤ x), Tendsto (fun σ' : ℝ ↦ ∫ t : ℝ, G (σ' + t * I) * ψ t * x ^ (t * I)) (𝓝[>] 1) (𝓝 (∫ t : ℝ, G (1 + t * I) * ψ t * x ^ (t * I))) := by letI := @CS.coeFunDict letI := @W1.coeFunDict letI := @W21.csDict intro hG ψ hx by_cases hh : tsupport ψ = ∅ · simp [tsupport_eq_empty_iff.mp hh] obtain ⟨a₀, ha₀⟩ := Set.nonempty_iff_ne_empty.mpr hh let S : Set ℂ := reProdIm (Icc 1 2) (tsupport ψ) have l1 : IsCompact S := by refine Metric.isCompact_iff_isClosed_bounded.mpr ⟨?_, ?_⟩ · exact isClosed_Icc.reProdIm (isClosed_tsupport ψ) · exact (Metric.isBounded_Icc 1 2).reProdIm ψ.h2.isBounded have l2 : S ⊆ {s : ℂ | 1 ≤ s.re} := fun z hz => (mem_reProdIm.mp hz).1.1 have l3 : ContinuousOn (‖G ·‖) S := (hG.mono l2).norm have l4 : S.Nonempty := ⟨1 + a₀ * I, by simp [S, mem_reProdIm, ha₀]⟩ obtain ⟨z, -, hmax⟩ := l1.exists_isMaxOn l4 l3 let MG := ‖G z‖ let bound (a : ℝ) : ℝ := MG * ‖ψ a‖ apply tendsto_integral_filter_of_dominated_convergence (bound := bound) · apply eventually_of_mem (U := Icc 1 2) (Icc_mem_nhdsGT_of_mem (by simp)) ; intro u hu apply Continuous.aestronglyMeasurable apply Continuous.mul · exact (hG.comp_continuous (by fun_prop) (by simp [hu.1])).mul ψ.h1.continuous · apply Continuous.const_cpow (by fun_prop) ; simp ; linarith · apply eventually_of_mem (U := Icc 1 2) (Icc_mem_nhdsGT_of_mem (by simp)) intro u hu apply Eventually.of_forall ; intro v by_cases h : v ∈ tsupport ψ · have r1 : u + v * I ∈ S := by simp [S, mem_reProdIm, hu.1, hu.2, h] have r2 := isMaxOn_iff.mp hmax _ r1 have r4 : (x : ℂ) ≠ 0 := by simp ; linarith have r5 : arg x = 0 := by simp [arg_eq_zero_iff] ; linarith have r3 : ‖(x : ℂ) ^ (v * I)‖ = 1 := by simp [norm_cpow_of_ne_zero r4, r5] simp_rw [norm_mul, r3, mul_one] exact mul_le_mul_of_nonneg_right r2 (norm_nonneg _) · have : v ∉ Function.support ψ := fun a ↦ h (subset_tsupport ψ a) simp at this ; simp [this, bound] · suffices h : Continuous bound by exact h.integrable_of_hasCompactSupport ψ.h2.norm.mul_left have := ψ.h1.continuous ; fun_prop · apply Eventually.of_forall ; intro t apply Tendsto.mul_const apply Tendsto.mul_const refine (hG (1 + t * I) (by simp)).tendsto.comp <| tendsto_nhdsWithin_iff.mpr ⟨?_, ?_⟩ · exact ((continuous_ofReal.tendsto _).add tendsto_const_nhds).mono_left nhdsWithin_le_nhds · exact eventually_nhdsWithin_of_forall (fun x (hx : 1 < x) => by simp [hx.le]) lemma limiting_fourier : letI := @CS.coeFunDict ∀ (hcheby : cheby f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (ψ : CS 2 ℂ) (hx : 1 ≤ x), ∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * log (n / x)) - A * ∫ u in Set.Ici (-log x), 𝓕 (ψ : ℝ → ℂ) (u / (2 * π)) = ∫ (t : ℝ), (G (1 + t * I)) * (ψ t) * x ^ (t * I) := by letI := @CS.coeFunDict letI := @W1.coeFunDict letI := @W21.csDict intro hcheby hG hG' hf ψ hx have l1 := limiting_fourier_lim1 hcheby ψ (by linarith) have l2 := limiting_fourier_lim2 A ψ hx have l3 := limiting_fourier_lim3 hG ψ hx apply tendsto_nhds_unique_of_eventuallyEq (l1.sub l2) l3 simpa [eventuallyEq_nhdsWithin_iff] using! Eventually.of_forall (limiting_fourier_aux hG' hf ψ hx) lemma limiting_cor_aux {f : ℝ → ℂ} : Tendsto (fun x : ℝ ↦ ∫ t, f t * x ^ (t * I)) atTop (𝓝 0) := by have l1 : ∀ᶠ x : ℝ in atTop, ∀ t : ℝ, x ^ (t * I) = exp (log x * t * I) := by filter_upwards [eventually_ne_atTop 0, eventually_ge_atTop 0] with x hx hx' t rw [Complex.cpow_def_of_ne_zero (ofReal_ne_zero.mpr hx), ofReal_log hx'] ; ring_nf have l2 : ∀ᶠ x : ℝ in atTop, ∫ t, f t * x ^ (t * I) = ∫ t, f t * exp (log x * t * I) := by filter_upwards [l1] with x hx refine integral_congr_ae (Eventually.of_forall (fun x => by simp [hx])) simp_rw [tendsto_congr' l2] convert_to Tendsto (fun x => 𝓕 f (-Real.log x / (2 * π))) atTop (𝓝 0) · ext x rw [Real.fourier_real_eq_integral_exp_smul] apply integral_congr_ae filter_upwards with t have hphase : -2 * π * t * (-Real.log x / (2 * π)) = Real.log x * t := by field_simp <;> ring rw [hphase, ofReal_mul, smul_eq_mul, mul_comm] refine (Real.zero_at_infty_fourier f).comp <| Tendsto.mono_right ?_ _root_.atBot_le_cocompact exact (tendsto_neg_atBot_iff.mpr tendsto_log_atTop).atBot_mul_const (inv_pos.mpr two_pi_pos) lemma limiting_cor : letI := @CS.coeFunDict ∀ (ψ : CS 2 ℂ) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hcheby : cheby f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}), Tendsto (fun x : ℝ ↦ ∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * log (n / x)) - A * ∫ u in Set.Ici (-log x), 𝓕 (ψ : ℝ → ℂ) (u / (2 * π))) atTop (𝓝 0) := by letI := @CS.coeFunDict letI := @W1.coeFunDict letI := @W21.csDict intro ψ hf hcheby hG hG' apply limiting_cor_aux.congr' filter_upwards [eventually_ge_atTop 1] with x hx using limiting_fourier hcheby hG hG' hf ψ hx |>.symm lemma smooth_urysohn (a b c d : ℝ) (h1 : a < b) (h3 : c < d) : ∃ Ψ : ℝ → ℝ, (ContDiff ℝ ∞ Ψ) ∧ (HasCompactSupport Ψ) ∧ Set.indicator (Set.Icc b c) 1 ≤ Ψ ∧ Ψ ≤ Set.indicator (Set.Ioo a d) 1 := by obtain ⟨ψ, l1, l2, l3, l4, -⟩ := smooth_urysohn_support_Ioo h1 h3 refine ⟨ψ, l1, l2, l3, l4⟩ noncomputable def exists_trunc : trunc := by choose ψ h1 h2 h3 h4 using smooth_urysohn (-2) (-1) (1) (2) (by linarith) (by linarith) exact ⟨⟨ψ, h1.of_le (by norm_cast), h2⟩, h3, h4⟩ lemma one_div_sub_one (n : ℕ) : 1 / (↑(n - 1) : ℝ) ≤ 2 / n := by match n with | 0 => simp | 1 => simp | n + 2 => { norm_cast ; rw [div_le_div_iff₀] <;> simp [mul_add] <;> linarith } lemma quadratic_pos (a b c x : ℝ) (ha : 0 < a) (hΔ : discrim a b c < 0) : 0 < a * x ^ 2 + b * x + c := by have l1 : a * x ^ 2 + b * x + c = a * (x + b / (2 * a)) ^ 2 - discrim a b c / (4 * a) := by simp only [discrim]; field_simp; ring have l2 : 0 < - discrim a b c := by linarith rw [l1, sub_eq_add_neg, ← neg_div] ; positivity noncomputable def pp (a x : ℝ) : ℝ := a ^ 2 * (x + 1) ^ 2 + (1 - a) * (1 + a) noncomputable def pp' (a x : ℝ) : ℝ := a ^ 2 * (2 * (x + 1)) lemma pp_pos {a : ℝ} (ha : a ∈ Ioo (-1) 1) (x : ℝ) : 0 < pp a x := by simp only [pp] have : 0 < 1 - a := by linarith [ha.2] have : 0 < 1 + a := by linarith [ha.1] positivity lemma pp_deriv (a x : ℝ) : HasDerivAt (pp a) (pp' a x) x := by unfold pp pp' simpa using hasDerivAt_id x |>.add_const 1 |>.pow 2 |>.const_mul _ lemma pp_deriv_eq (a : ℝ) : deriv (pp a) = pp' a := by ext x ; exact pp_deriv a x |>.deriv lemma pp'_deriv (a x : ℝ) : HasDerivAt (pp' a) (a ^ 2 * 2) x := by simpa using! hasDerivAt_id x |>.add_const 1 |>.const_mul 2 |>.const_mul (a ^ 2) lemma pp'_deriv_eq (a : ℝ) : deriv (pp' a) = fun _ => a ^ 2 * 2 := by ext x ; exact pp'_deriv a x |>.deriv noncomputable def hh (a t : ℝ) : ℝ := (t * (1 + (a * log t) ^ 2))⁻¹ noncomputable def hh' (a t : ℝ) : ℝ := - pp a (log t) * hh a t ^ 2 lemma hh_nonneg (a : ℝ) {t : ℝ} (ht : 0 ≤ t) : 0 ≤ hh a t := by dsimp only [hh] ; positivity lemma hh_le (a t : ℝ) (ht : 0 ≤ t) : |hh a t| ≤ t⁻¹ := by by_cases h0 : t = 0 · simp [hh, h0] replace ht : 0 < t := lt_of_le_of_ne ht (by tauto) unfold hh rw [abs_inv, inv_le_inv₀ (by positivity) ht, abs_mul, abs_eq_self.mpr ht.le] convert_to! t * 1 ≤ _ · simp apply mul_le_mul le_rfl ?_ zero_le_one ht.le rw [abs_eq_self.mpr (by positivity)] simp only [le_add_iff_nonneg_right] positivity lemma hh_deriv (a : ℝ) {t : ℝ} (ht : t ≠ 0) : HasDerivAt (hh a) (hh' a t) t := by have e1 : t * (1 + (a * log t) ^ 2) ≠ 0 := mul_ne_zero ht (_root_.ne_of_lt (by positivity)).symm have l5 : HasDerivAt (fun t : ℝ => log t) t⁻¹ t := Real.hasDerivAt_log ht have l4 : HasDerivAt (fun t : ℝ => a * log t) (a * t⁻¹) t := l5.const_mul _ have l3 : HasDerivAt (fun t : ℝ => (a * log t) ^ 2) (2 * a ^ 2 * t⁻¹ * log t) t := by convert! l4.pow 2 using 1 ; ring have l2 : HasDerivAt (fun t : ℝ => 1 + (a * log t) ^ 2) (2 * a ^ 2 * t⁻¹ * log t) t := l3.const_add _ have l1 : HasDerivAt (fun t : ℝ => t * (1 + (a * log t) ^ 2)) (1 + 2 * a ^ 2 * log t + a ^ 2 * log t ^ 2) t := by convert! (hasDerivAt_id' t).mul l2 using 1; field_simp; ring convert! l1.inv e1 using 1; simp only [hh', pp, hh]; field_simp; ring lemma hh_continuous (a : ℝ) : ContinuousOn (hh a) (Ioi 0) := fun t (ht : 0 < t) => (hh_deriv a ht.ne.symm).continuousAt.continuousWithinAt lemma hh'_nonpos {a x : ℝ} (ha : a ∈ Ioo (-1) 1) : hh' a x ≤ 0 := by have := pp_pos ha (log x) simp only [hh', neg_mul, Left.neg_nonpos_iff, ge_iff_le] positivity lemma hh_antitone {a : ℝ} (ha : a ∈ Ioo (-1) 1) : AntitoneOn (hh a) (Ioi 0) := by have l1 x (hx : x ∈ interior (Ioi 0)) : HasDerivWithinAt (hh a) (hh' a x) (interior (Ioi 0)) x := by have : x ≠ 0 := by contrapose! hx ; simp [hx] exact (hh_deriv a this).hasDerivWithinAt apply antitoneOn_of_hasDerivWithinAt_nonpos (convex_Ioi _) (hh_continuous _) l1 (fun x _ => hh'_nonpos ha) noncomputable def gg (x i : ℝ) : ℝ := 1 / i * (1 + (1 / (2 * π) * log (i / x)) ^ 2)⁻¹ lemma gg_of_hh {x : ℝ} (hx : x ≠ 0) (i : ℝ) : gg x i = x⁻¹ * hh (1 / (2 * π)) (i / x) := by simp only [gg, hh] field_simp lemma gg_l1 {x : ℝ} (hx : 0 < x) (n : ℕ) : |gg x n| ≤ 1 / n := by simp only [gg_of_hh hx.ne.symm, one_div, mul_inv_rev, abs_mul] apply mul_le_mul le_rfl (hh_le _ _ (by positivity)) (by positivity) (by positivity) |>.trans (le_of_eq ?_) simp [abs_inv, abs_eq_self.mpr hx.le] ; field_simp lemma gg_le_one (i : ℕ) : gg x i ≤ 1 := by by_cases hi : i = 0 <;> simp only [gg, hi, CharP.cast_eq_zero, div_zero, one_div, mul_inv_rev, zero_div, Real.log_zero, mul_zero, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, add_zero, inv_one, mul_one, zero_le_one] have l1 : 1 ≤ (i : ℝ) := by simp ; omega have l2 : 1 ≤ 1 + (π⁻¹ * 2⁻¹ * Real.log (↑i / x)) ^ 2 := by simp only [le_add_iff_nonneg_right] ; positivity rw [← mul_inv] ; apply inv_le_one_of_one_le₀ ; simpa using mul_le_mul l1 l2 zero_le_one (by simp) lemma one_div_two_pi_mem_Ioo : 1 / (2 * π) ∈ Ioo (-1) 1 := by constructor · trans 0 · linarith · positivity · rw [div_lt_iff₀ (by positivity)] convert_to! 1 * 1 < 2 * π · simp · simp apply mul_lt_mul one_lt_two ?_ zero_lt_one zero_le_two trans 2 · exact one_le_two · exact two_le_pi lemma sum_telescopic (a : ℕ → ℝ) (n : ℕ) : ∑ i ∈ Finset.range n, (a (i + 1) - a i) = a n - a 0 := by apply Finset.sum_range_sub lemma cancel_aux {C : ℝ} {f g : ℕ → ℝ} (hf : 0 ≤ f) (hg : 0 ≤ g) (hf' : ∀ n, cumsum f n ≤ C * n) (hg' : Antitone g) (n : ℕ) : ∑ i ∈ Finset.range n, f i * g i ≤ g (n - 1) * (C * n) + (C * (↑(n - 1 - 1) + 1) * g 0 - C * (↑(n - 1 - 1) + 1) * g (n - 1) - ((n - 1 - 1) • (C * g 0) - ∑ x ∈ Finset.range (n - 1 - 1), C * g (x + 1))) := by have l1 (n : ℕ) : (g n - g (n + 1)) * ∑ i ∈ Finset.range (n + 1), f i ≤ (g n - g (n + 1)) * (C * (n + 1)) := by apply mul_le_mul le_rfl (by simpa using! hf' (n + 1)) (Finset.sum_nonneg' hf) ?_ simp only [sub_nonneg] ; apply hg' ; simp have l2 (x : ℕ) : C * (↑(x + 1) + 1) - C * (↑x + 1) = C := by simp ; ring have l3 (n : ℕ) : 0 ≤ cumsum f n := Finset.sum_nonneg' hf convert_to ∑ i ∈ Finset.range n, (g i) • (f i) ≤ _ · simp [mul_comm] rw [Finset.sum_range_by_parts, sub_eq_add_neg, ← Finset.sum_neg_distrib] simp_rw [← neg_smul, neg_sub, smul_eq_mul] apply _root_.add_le_add · exact mul_le_mul le_rfl (hf' n) (l3 n) (hg _) · apply Finset.sum_le_sum (fun n _ => l1 n) |>.trans convert_to! ∑ i ∈ Finset.range (n - 1), (C * (↑i + 1)) • (g i - g (i + 1)) ≤ _ · congr ; ext i ; simp ; ring rw [Finset.sum_range_by_parts] simp_rw [Finset.sum_range_sub', l2, smul_sub, smul_eq_mul, Finset.sum_sub_distrib, Finset.sum_const, Finset.card_range] apply le_of_eq ; ring_nf lemma sum_range_succ (a : ℕ → ℝ) (n : ℕ) : ∑ i ∈ Finset.range n, a (i + 1) = (∑ i ∈ Finset.range (n + 1), a i) - a 0 := by have := Finset.sum_range_sub a n rw [Finset.sum_sub_distrib, sub_eq_iff_eq_add] at this rw [Finset.sum_range_succ, this] ; ring lemma cancel_aux' {C : ℝ} {f g : ℕ → ℝ} (hf : 0 ≤ f) (hg : 0 ≤ g) (hf' : ∀ n, cumsum f n ≤ C * n) (hg' : Antitone g) (n : ℕ) : ∑ i ∈ Finset.range n, f i * g i ≤ C * n * g (n - 1) + C * cumsum g (n - 1 - 1 + 1) - C * (↑(n - 1 - 1) + 1) * g (n - 1) := by have := cancel_aux hf hg hf' hg' n simp only [nsmul_eq_mul, ← Finset.mul_sum, sum_range_succ] at this convert this using 1 ; unfold cumsum ; ring lemma cancel_main {C : ℝ} {f g : ℕ → ℝ} (hf : 0 ≤ f) (hg : 0 ≤ g) (hf' : ∀ n, cumsum f n ≤ C * n) (hg' : Antitone g) (n : ℕ) (hn : 2 ≤ n) : cumsum (f * g) n ≤ C * cumsum g n := by convert! cancel_aux' hf hg hf' hg' n using 1 match n with | n + 2 => simp only [cumsum_succ] ; push_cast ; ring lemma cancel_main' {C : ℝ} {f g : ℕ → ℝ} (hf : 0 ≤ f) (hf0 : f 0 = 0) (hg : 0 ≤ g) (hf' : ∀ n, cumsum f n ≤ C * n) (hg' : Antitone g) (n : ℕ) : cumsum (f * g) n ≤ C * cumsum g n := by match n with | 0 => simp [cumsum] | 1 => specialize hg 0 ; specialize hf' 1 ; simp only [cumsum, Finset.range_one, Finset.sum_singleton, hf0, Nat.cast_one, mul_one, Pi.zero_apply, Pi.mul_apply, zero_mul, ge_iff_le] at hf' hg ⊢ ; positivity | n + 2 => convert! cancel_aux' hf hg hf' hg' (n + 2) using 1 ; simp [cumsum_succ] ; ring theorem sum_le_integral {x₀ : ℝ} {f : ℝ → ℝ} {n : ℕ} (hf : AntitoneOn f (Ioc x₀ (x₀ + n))) (hfi : IntegrableOn f (Icc x₀ (x₀ + n))) : (∑ i ∈ Finset.range n, f (x₀ + ↑(i + 1))) ≤ ∫ x in x₀..x₀ + n, f x := by cases n with simp only [Nat.cast_add, Nat.cast_one, CharP.cast_eq_zero, add_zero, lt_self_iff_false, not_false_eq_true, Ioc_eq_empty, Finset.range_zero, Nat.cast_add, Nat.cast_one, Finset.sum_empty, intervalIntegral.integral_same, le_refl] at hf ⊢ | succ n => have : Finset.range (n + 1) = {0} ∪ Finset.Ico 1 (n + 1) := by ext i ; by_cases hi : i = 0 <;> simp [hi] ; omega simp only [this, Finset.singleton_union, Finset.mem_Ico, nonpos_iff_eq_zero, one_ne_zero, lt_add_iff_pos_left, add_pos_iff, zero_lt_one, or_true, and_true, not_false_eq_true, Finset.sum_insert, CharP.cast_eq_zero, zero_add, ge_iff_le] have l4 : IntervalIntegrable f volume x₀ (x₀ + 1) := by apply IntegrableOn.intervalIntegrable simp only [le_add_iff_nonneg_right, zero_le_one, uIcc_of_le] apply hfi.mono_set apply Icc_subset_Icc le_rfl simp have l5 x (hx : x ∈ Ioc x₀ (x₀ + 1)) : (fun x ↦ f (x₀ + 1)) x ≤ f x := by rcases hx with ⟨hx1, hx2⟩ refine hf ⟨hx1, by linarith⟩ ⟨by linarith, by linarith⟩ hx2 have l6 : ∫ x in x₀..x₀ + 1, f (x₀ + 1) = f (x₀ + 1) := by simp have l1 : f (x₀ + 1) ≤ ∫ x in x₀..x₀ + 1, f x := by rw [← l6] ; apply intervalIntegral.integral_mono_ae_restrict (by linarith) (by simp) l4 apply eventually_of_mem _ l5 have : (Ioc x₀ (x₀ + 1))ᶜ ∩ Icc x₀ (x₀ + 1) = {x₀} := by simp [← sdiff_eq_compl_inter] apply mem_ae_iff.mpr rw [Measure.restrict_apply measurableSet_Ioc.compl, this] exact measure_singleton x₀ have l2 : AntitoneOn (fun x ↦ f (x₀ + x)) (Icc 1 ↑(n + 1)) := by intro u ⟨hu1, _⟩ v ⟨_, hv2⟩ huv ; push_cast at hv2 refine hf ⟨?_, ?_⟩ ⟨?_, ?_⟩ ?_ <;> linarith have l3 := @AntitoneOn.sum_le_integral_Ico 1 (n + 1) (fun x => f (x₀ + x)) (by simp) (by simpa using l2) simp only [Nat.cast_add, Nat.cast_one, intervalIntegral.integral_comp_add_left] at l3 convert! _root_.add_le_add l1 l3 have := @intervalIntegral.integral_comp_mul_add ℝ _ _ 1 (n + 1) 1 f one_ne_zero x₀ rw [intervalIntegral.integral_add_adjacent_intervals] · exact l4 · apply IntegrableOn.intervalIntegrable simp only [add_le_add_iff_left, le_add_iff_nonneg_left, Nat.cast_nonneg, uIcc_of_le] apply hfi.mono_set apply Icc_subset_Icc · linarith · simp lemma hh_integrable_aux (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (IntegrableOn (fun t ↦ a * hh b (t / c)) (Ici 0)) ∧ (∫ (t : ℝ) in Ioi 0, a * hh b (t / c) = a * c / b * π) := by rw [integrableOn_Ici_iff_integrableOn_Ioi] simp only [hh] let g (x : ℝ) := (a * c / b) * Real.arctan (b * log (x / c)) let g₀ (x : ℝ) := if x = 0 then ((a * c / b) * (- (π / 2))) else g x let g' (x : ℝ) := a * (x / c * (1 + (b * Real.log (x / c)) ^ 2))⁻¹ have l3 (x) (hx : 0 < x) : HasDerivAt Real.log x⁻¹ x := by apply Real.hasDerivAt_log (by linarith) have l4 (x) : HasDerivAt (fun t => t / c) (1 / c) x := (hasDerivAt_id x).div_const c have l2 (x) (hx : 0 < x) : HasDerivAt (fun t => log (t / c)) x⁻¹ x := by have := @HasDerivAt.comp _ _ _ _ _ _ (fun t => t / c) _ _ _ (l3 (x / c) (by positivity)) (l4 x) convert! this using 1 ; field_simp have l5 (x) (hx : 0 < x) := (l2 x hx).const_mul b have l1 (x) (hx : 0 < x) := (l5 x hx).arctan have l6 (x) (hx : 0 < x) : HasDerivAt g (g' x) x := by convert! (l1 x hx).const_mul (a * c / b) using 1 simp only [g'] field_simp have key (x) (hx : 0 < x) : HasDerivAt g₀ (g' x) x := by apply (l6 x hx).congr_of_eventuallyEq apply eventually_of_mem <| Ioi_mem_nhds hx intro y (hy : 0 < y) simp [g₀, hy.ne.symm] have k1 : Tendsto g₀ atTop (𝓝 ((a * c / b) * (π / 2))) := by have : g =ᶠ[atTop] g₀ := by apply eventually_of_mem (Ioi_mem_atTop 0) intro y (hy : 0 < y) simp [g₀, hy.ne.symm] apply Tendsto.congr' this apply Tendsto.const_mul apply (tendsto_arctan_atTop.mono_right nhdsWithin_le_nhds).comp apply Tendsto.const_mul_atTop hb apply tendsto_log_atTop.comp apply Tendsto.atTop_div_const hc apply tendsto_id have k2 : Tendsto g₀ (𝓝[>] 0) (𝓝 (g₀ 0)) := by have : g =ᶠ[𝓝[>] 0] g₀ := by apply eventually_of_mem self_mem_nhdsWithin intro x (hx : 0 < x) ; simp [g₀, hx.ne.symm] simp only [g₀] apply Tendsto.congr' this apply Tendsto.const_mul apply (tendsto_arctan_atBot.mono_right nhdsWithin_le_nhds).comp apply Tendsto.const_mul_atBot hb apply tendsto_log_nhdsGT_zero.comp rw [Metric.tendsto_nhdsWithin_nhdsWithin] intro ε hε refine ⟨c * ε, by positivity, fun x hx1 hx2 => ⟨?_, ?_⟩⟩ · simp only [mem_Ioi] at hx1 ⊢ ; positivity · simp only [dist_zero_right, norm_eq_abs, norm_div, abs_eq_self.mpr hc.le] at hx2 ⊢ rwa [div_lt_iff₀ hc, mul_comm] have k3 : ContinuousWithinAt g₀ (Ici 0) 0 := by rw [Metric.continuousWithinAt_iff] rw [Metric.tendsto_nhdsWithin_nhds] at k2 peel k2 with ε hε δ hδ x h intro (hx : 0 ≤ x) have := le_iff_lt_or_eq.mp hx cases this with | inl hx => exact h hx | inr hx => simp [g₀, hx.symm, hε] have k4 : ∀ x ∈ Ioi 0, 0 ≤ g' x := by intro x (hx : 0 < x) ; simp only [mul_inv_rev, inv_div, g'] ; positivity constructor · convert_to IntegrableOn g' _ exact integrableOn_Ioi_deriv_of_nonneg k3 key k4 k1 · have := integral_Ioi_of_hasDerivAt_of_nonneg k3 key k4 k1 simp only [mul_inv_rev, inv_div, mul_neg, ↓reduceIte, sub_neg_eq_add, g', g₀] at this ⊢ convert this using 1 ; field_simp ; ring lemma hh_integrable (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : IntegrableOn (fun t ↦ a * hh b (t / c)) (Ici 0) := hh_integrable_aux ha hb hc |>.1 lemma hh_integral (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : ∫ (t : ℝ) in Ioi 0, a * hh b (t / c) = a * c / b * π := hh_integrable_aux ha hb hc |>.2 lemma hh_integral' : ∫ t in Ioi 0, hh (1 / (2 * π)) t = 2 * π ^ 2 := by have := hh_integral (a := 1) (b := 1 / (2 * π)) (c := 1) (by positivity) (by positivity) (by positivity) convert this using 1 <;> simp ; ring lemma bound_sum_log {C : ℝ} (hf0 : f 0 = 0) (hf : chebyWith C f) {x : ℝ} (hx : 1 ≤ x) : ∑' i, ‖f i‖ / i * (1 + (1 / (2 * π) * log (i / x)) ^ 2)⁻¹ ≤ C * (1 + ∫ t in Ioi 0, hh (1 / (2 * π)) t) := by let ggg (i : ℕ) : ℝ := if i = 0 then 1 else gg x i have l0 : x ≠ 0 := by linarith have l1 i : 0 ≤ ggg i := by by_cases hi : i = 0 <;> simp only [gg, one_div, mul_inv_rev, hi, ↓reduceIte, zero_le_one, ggg] ; positivity have l2 : Antitone ggg := by intro i j hij ; by_cases hi : i = 0 <;> by_cases hj : j = 0 <;> simp only [hj, ↓reduceIte, hi, le_refl, ggg] · exact gg_le_one _ · omega · simp only [gg_of_hh l0] gcongr apply hh_antitone one_div_two_pi_mem_Ioo · simp only [mem_Ioi] ; positivity · simp only [mem_Ioi] ; positivity · gcongr have l3 : 0 ≤ C := by simpa [cumsum, hf0] using hf 1 have l4 : 0 ≤ ∫ (t : ℝ) in Ioi 0, hh (π⁻¹ * 2⁻¹) t := setIntegral_nonneg measurableSet_Ioi (fun x hx => hh_nonneg _ (LT.lt.le hx)) have l5 {n : ℕ} : AntitoneOn (fun t ↦ x⁻¹ * hh (1 / (2 * π)) (t / x)) (Ioc 0 n) := by intro u ⟨hu1, _⟩ v ⟨hv1, _⟩ huv simp only apply mul_le_mul le_rfl ?_ (hh_nonneg _ (by positivity)) (by positivity) apply hh_antitone one_div_two_pi_mem_Ioo (by simp only [mem_Ioi] ; positivity) (by simp only [mem_Ioi] ; positivity) apply (div_le_div_iff_of_pos_right (by positivity)).mpr huv have l6 {n : ℕ} : IntegrableOn (fun t ↦ x⁻¹ * hh (π⁻¹ * 2⁻¹) (t / x)) (Icc 0 n) volume := by apply IntegrableOn.mono_set (hh_integrable (by positivity) (by positivity) (by positivity)) Icc_subset_Ici_self apply Real.tsum_le_of_sum_range_le (fun n => by positivity) ; intro n convert_to! ∑ i ∈ Finset.range n, ‖f i‖ * ggg i ≤ _ · congr ; ext i by_cases hi : i = 0 · simp [hi, hf0] · simp only [gg, hi, ↓reduceIte, ggg] field_simp apply cancel_main' (fun _ => norm_nonneg _) (by simp [hf0]) l1 hf l2 n |>.trans gcongr ; simp only [cumsum, gg_of_hh l0, one_div, mul_inv_rev, ggg] by_cases hn : n = 0 · simp only [hn, Finset.range_zero, Finset.sum_empty] ; positivity replace hn : 0 < n := by omega have : Finset.range n = {0} ∪ Finset.Ico 1 n := by ext i ; simp ; by_cases hi : i = 0 <;> simp [hi, hn] ; omega simp only [this, Finset.singleton_union, Finset.mem_Ico, nonpos_iff_eq_zero, one_ne_zero, false_and, not_false_eq_true, Finset.sum_insert, ↓reduceIte, add_le_add_iff_left, ge_iff_le] convert_to! ∑ x_1 ∈ Finset.Ico 1 n, x⁻¹ * hh (π⁻¹ * 2⁻¹) (↑x_1 / x) ≤ _ · apply Finset.sum_congr rfl (fun i hi => ?_) simp at hi have : i ≠ 0 := by omega simp [this] simp_rw [Finset.sum_Ico_eq_sum_range, add_comm 1] have := @sum_le_integral 0 (fun t => x⁻¹ * hh (π⁻¹ * 2⁻¹) (t / x)) (n - 1) (by simpa using l5) (by simpa using l6) simp only [zero_add] at this apply this.trans rw [@intervalIntegral.integral_comp_div ℝ _ _ 0 ↑(n - 1) x (fun t => x⁻¹ * hh (π⁻¹ * 2⁻¹) (t)) l0] simp only [zero_div, intervalIntegral.integral_const_mul, smul_eq_mul, ← mul_assoc, mul_inv_cancel₀ l0, one_mul] have : (0 : ℝ) ≤ ↑(n - 1) / x := by positivity rw [intervalIntegral.intervalIntegral_eq_integral_uIoc] simp only [this, ↓reduceIte, uIoc_of_le, smul_eq_mul, one_mul, ge_iff_le] apply integral_mono_measure · apply Measure.restrict_mono Ioc_subset_Ioi_self le_rfl · apply eventually_of_mem (self_mem_ae_restrict measurableSet_Ioi) intro x (hx : 0 < x) apply hh_nonneg _ hx.le · have := (@hh_integrable 1 (1 / (2 * π)) 1 (by positivity) (by positivity) (by positivity)) simpa using! this.mono_set Ioi_subset_Ici_self lemma bound_sum_log0 {C : ℝ} (hf : chebyWith C f) {x : ℝ} (hx : 1 ≤ x) : ∑' i, ‖f i‖ / i * (1 + (1 / (2 * π) * log (i / x)) ^ 2)⁻¹ ≤ C * (1 + ∫ t in Ioi 0, hh (1 / (2 * π)) t) := by let f0 i := if i = 0 then 0 else f i have l1 : chebyWith C f0 := by intro n ; refine Finset.sum_le_sum (fun i _ => ?_) |>.trans (hf n) by_cases hi : i = 0 <;> simp [hi, f0] have l2 i : ‖f i‖ / i = ‖f0 i‖ / i := by by_cases hi : i = 0 <;> simp [hi, f0] simp_rw [l2] ; apply bound_sum_log rfl l1 hx lemma bound_sum_log' {C : ℝ} (hf : chebyWith C f) {x : ℝ} (hx : 1 ≤ x) : ∑' i, ‖f i‖ / i * (1 + (1 / (2 * π) * log (i / x)) ^ 2)⁻¹ ≤ C * (1 + 2 * π ^ 2) := by simpa only [hh_integral'] using bound_sum_log0 hf hx variable (f x) in lemma summable_fourier_aux : letI := @W1.coeFunDict ∀ (ψ : W21) (i : ℕ), ‖f i / i * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * Real.log (i / x))‖ ≤ W21.norm ψ * (‖f i‖ / i * (1 + (1 / (2 * π) * log (i / x)) ^ 2)⁻¹) := by letI := @W1.coeFunDict intro ψ i convert! mul_le_mul_of_nonneg_left (decay_bounds_key ψ (1 / (2 * π) * log (i / x))) (norm_nonneg (f i / i)) using 1 · simp · change _ = _ * (W21.norm ψ * _) simp only [W21.norm, mul_inv_rev, one_div, Complex.norm_div, RCLike.norm_natCast] ring lemma summable_fourier : letI := @W1.coeFunDict ∀ (x : ℝ) (hx : 0 < x) (ψ : W21) (hcheby : cheby f), Summable fun i ↦ ‖f i / ↑i * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * Real.log (↑i / x))‖ := by letI := @W1.coeFunDict intro x hx ψ hcheby have l5 : Summable fun i ↦ ‖f i‖ / ↑i * ((1 + (1 / (2 * ↑π) * ↑(Real.log (↑i / x))) ^ 2)⁻¹) := by simpa using limiting_fourier_lim1_aux hcheby hx 1 (zero_le_one' ℝ) have l6 := summable_fourier_aux x f ψ exact Summable.of_nonneg_of_le (fun _ => norm_nonneg _) l6 (by simpa using l5.const_smul (W21.norm ψ)) lemma bound_I1 : letI := @W1.coeFunDict ∀ (x : ℝ) (hx : 0 < x) (ψ : W21) (hcheby : cheby f), ‖∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * log (n / x))‖ ≤ W21.norm ψ • ∑' i, ‖f i‖ / i * (1 + (1 / (2 * π) * log (i / x)) ^ 2)⁻¹ := by letI := @W1.coeFunDict intro x hx ψ hcheby have l5 : Summable fun i ↦ ‖f i‖ / ↑i * ((1 + (1 / (2 * ↑π) * ↑(Real.log (↑i / x))) ^ 2)⁻¹) := by simpa using limiting_fourier_lim1_aux hcheby hx 1 (zero_le_one' ℝ) have l6 := summable_fourier_aux x f ψ have l1 : Summable fun i ↦ ‖f i / ↑i * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * Real.log (↑i / x))‖ := by exact summable_fourier x hx ψ hcheby apply (norm_tsum_le_tsum_norm l1).trans simpa only [← Summable.tsum_const_smul _ l5] using! Summable.tsum_mono l1 (by simpa using l5.const_smul (W21.norm ψ)) l6 lemma bound_I1' : letI := @W1.coeFunDict ∀ {C : ℝ} (x : ℝ) (hx : 1 ≤ x) (ψ : W21) (hcheby : chebyWith C f), ‖∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * log (n / x))‖ ≤ W21.norm ψ * C * (1 + 2 * π ^ 2) := by letI := @W1.coeFunDict intro C x hx ψ hcheby apply bound_I1 x (by linarith) ψ ⟨_, hcheby⟩ |>.trans rw [smul_eq_mul, mul_assoc] apply mul_le_mul le_rfl (bound_sum_log' hcheby hx) ?_ W21.norm_nonneg apply tsum_nonneg (fun i => by positivity) lemma bound_I2 : letI := @W1.coeFunDict ∀ (x : ℝ) (ψ : W21), ‖∫ u in Set.Ici (-log x), 𝓕 (ψ : ℝ → ℂ) (u / (2 * π))‖ ≤ W21.norm ψ * (2 * π ^ 2) := by letI := @W1.coeFunDict intro x ψ have key a : ‖𝓕 (ψ : ℝ → ℂ) (a / (2 * π))‖ ≤ W21.norm ψ * (1 + (a / (2 * π)) ^ 2)⁻¹ := decay_bounds_key ψ _ have twopi : 0 ≤ 2 * π := by simp [pi_nonneg] have l3 : Integrable (fun a ↦ (1 + (a / (2 * π)) ^ 2)⁻¹) := integrable_inv_one_add_sq.comp_div (by norm_num [pi_ne_zero]) have l2 : IntegrableOn (fun i ↦ W21.norm ψ * (1 + (i / (2 * π)) ^ 2)⁻¹) (Ici (-Real.log x)) := by exact (l3.const_mul _).integrableOn have l1 : IntegrableOn (fun i ↦ ‖𝓕 (ψ : ℝ → ℂ) (i / (2 * π))‖) (Ici (-Real.log x)) := by refine ((l3.const_mul (W21.norm ψ)).mono' ?_ ?_).integrableOn · exact ((continuous_FourierIntegral ψ).comp (continuous_id.div_const (2 * π))).norm.aestronglyMeasurable · simp only [norm_norm, key] ; simp have l5 : 0 ≤ᵐ[volume] fun a ↦ (1 + (a / (2 * π)) ^ 2)⁻¹ := by apply Eventually.of_forall ; intro x ; positivity refine (norm_integral_le_integral_norm _).trans <| (setIntegral_mono l1 l2 key).trans ?_ rw [integral_const_mul] ; gcongr · apply W21.norm_nonneg refine (setIntegral_le_integral l3 l5).trans ?_ rw [Measure.integral_comp_div (fun x => (1 + x ^ 2)⁻¹) (2 * π)] simp [abs_eq_self.mpr twopi] ; ring_nf ; rfl lemma bound_main : letI := @W1.coeFunDict ∀ {C : ℝ} (A : ℂ) (x : ℝ) (hx : 1 ≤ x) (ψ : W21) (hcheby : chebyWith C f), ‖∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * log (n / x)) - A * ∫ u in Set.Ici (-log x), 𝓕 (ψ : ℝ → ℂ) (u / (2 * π))‖ ≤ W21.norm ψ * (C * (1 + 2 * π ^ 2) + ‖A‖ * (2 * π ^ 2)) := by letI := @W1.coeFunDict intro C A x hx ψ hcheby have l1 := bound_I1' x hx ψ hcheby have l2 := mul_le_mul (le_refl ‖A‖) (bound_I2 x ψ) (by positivity) (by positivity) apply norm_sub_le _ _ |>.trans ; rw [norm_mul] convert _root_.add_le_add l1 l2 using 1 ; ring lemma limiting_cor_W21 : letI := @W1.coeFunDict ∀ (ψ : W21) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hcheby : cheby f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}), Tendsto (fun x : ℝ ↦ ∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * log (n / x)) - A * ∫ u in Set.Ici (-log x), 𝓕 (ψ : ℝ → ℂ) (u / (2 * π))) atTop (𝓝 0) := by letI := @W1.coeFunDict letI := @CS.coeFunDict letI := @CS.realComplexDict letI := @trunc.coeFunDict letI := @trunc.csDict letI := @W1.subDict letI := @W21.csDict letI := @W21.mulComplexDict letI := @W21.mulRealDict intro ψ hf hcheby hG hG' -- Shorter notation for clarity let S1 x (ψ : ℝ → ℂ) := ∑' (n : ℕ), f n / ↑n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * Real.log (↑n / x)) let S2 x (ψ : ℝ → ℂ) := ↑A * ∫ (u : ℝ) in Ici (-Real.log x), 𝓕 (ψ : ℝ → ℂ) (u / (2 * π)) let S x ψ := S1 x ψ - S2 x ψ ; change Tendsto (fun x ↦ S x ψ) atTop (𝓝 0) -- Build the truncation obtain g := exists_trunc let Ψ R := g.scale R * ψ have key R : Tendsto (fun x ↦ S x (Ψ R)) atTop (𝓝 0) := limiting_cor (Ψ R) hf hcheby hG hG' -- Choose the truncation radius obtain ⟨C, hcheby⟩ := hcheby have hC : 0 ≤ C := by have : ‖f 0‖ ≤ C := by simpa [cumsum] using hcheby 1 have : 0 ≤ ‖f 0‖ := by positivity linarith have key2 : Tendsto (fun R ↦ W21.norm (ψ - Ψ R)) atTop (𝓝 0) := W21_approximation ψ g simp_rw [Metric.tendsto_nhds] at key key2 ⊢ ; intro ε hε let M := C * (1 + 2 * π ^ 2) + ‖(A : ℂ)‖ * (2 * π ^ 2) obtain ⟨R, hRψ⟩ := (key2 ((ε / 2) / (1 + M)) (by positivity)).exists simp only [dist_zero_right, Real.norm_eq_abs, abs_eq_self.mpr W21.norm_nonneg] at hRψ key -- Apply the compact support case filter_upwards [eventually_ge_atTop 1, key R (ε / 2) (by positivity)] with x hx key -- Control the tail term have key3 : ‖S x (ψ - Ψ R)‖ < ε / 2 := by have : ‖S x _‖ ≤ _ * M := @bound_main f C A x hx (ψ - Ψ R) hcheby apply this.trans_lt apply (mul_le_mul (d := 1 + M) le_rfl (by simp) (by positivity) W21.norm_nonneg).trans_lt have : 0 < 1 + M := by positivity convert! (mul_lt_mul_iff_left₀ this).mpr hRψ using 1 ; field_simp -- Conclude the proof have S1_sub_1 x : 𝓕 (⇑ψ - ⇑(Ψ R)) x = 𝓕 (ψ : ℝ → ℂ) x - 𝓕 ⇑(Ψ R) x := by have l1 : AEStronglyMeasurable (fun x_1 : ℝ ↦ cexp (-(2 * ↑π * (↑x_1 * ↑x) * I))) volume := by refine (Continuous.mul ?_ continuous_const).neg.cexp.aestronglyMeasurable apply continuous_const.mul <| contDiff_ofReal.continuous.mul continuous_const simp only [Real.fourier_eq', neg_mul, RCLike.inner_apply', conj_trivial, ofReal_neg, ofReal_mul, ofReal_ofNat, Pi.sub_apply, smul_eq_mul, mul_sub] apply integral_sub · apply ψ.hf.bdd_mul (c := 1) l1 ; simp [Complex.norm_exp] · apply (Ψ R : W21) |>.hf |>.bdd_mul (c := 1) l1 simp [Complex.norm_exp] have S1_sub : S1 x (ψ - Ψ R) = S1 x ψ - S1 x (Ψ R) := by change (∑' n, f n / n * 𝓕 (ψ.toFun - (Ψ R).toFun) (1 / (2 * π) * Real.log (n / x))) = S1 x ψ - S1 x (Ψ R) simp only [one_div, mul_inv_rev, S1_sub_1, mul_sub, S1] ; apply Summable.tsum_sub · have := summable_fourier x (by positivity) ψ ⟨_, hcheby⟩ rw [summable_norm_iff] at this simpa using this · have := summable_fourier x (by positivity) (Ψ R) ⟨_, hcheby⟩ rw [summable_norm_iff] at this simpa using! this have S2_sub : S2 x (ψ - Ψ R) = S2 x ψ - S2 x (Ψ R) := by change ↑A * (∫ u in Ici (-Real.log x), 𝓕 (ψ.toFun - (Ψ R).toFun) (u / (2 * π))) = S2 x ψ - S2 x (Ψ R) simp only [S1_sub_1, S2] ; rw [integral_sub] · ring · exact ψ.integrable_fourier (by positivity) |>.restrict · exact (Ψ R : W21).integrable_fourier (by positivity) |>.restrict have S_sub : S x (ψ - Ψ R) = S x ψ - S x (Ψ R) := by simp [S, S1_sub, S2_sub] ; ring simpa [S_sub, Ψ] using norm_add_le _ _ |>.trans_lt (_root_.add_lt_add key3 key) lemma limiting_cor_schwartz (ψ : 𝓢(ℝ, ℂ)) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hcheby : cheby f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) : Tendsto (fun x : ℝ ↦ ∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * log (n / x)) - A * ∫ u in Set.Ici (-log x), 𝓕 (ψ : ℝ → ℂ) (u / (2 * π))) atTop (𝓝 0) := by letI := @W1.coeFunDict letI := @W21.schwartzDict exact limiting_cor_W21 ψ hf hcheby hG hG' -- just the surjectivity is stated here, as this is all that is needed for the current -- application, but perhaps one should state and prove bijectivity instead lemma fourier_surjection_on_schwartz (f : 𝓢(ℝ, ℂ)) : ∃ g : 𝓢(ℝ, ℂ), 𝓕 g = f := by refine ⟨𝓕⁻ f, ?_⟩ exact FourierTransform.fourier_fourierInv_eq f noncomputable def toSchwartz (f : ℝ → ℂ) (h1 : ContDiff ℝ ∞ f) (h2 : HasCompactSupport f) : 𝓢(ℝ, ℂ) where toFun := f smooth' := h1 decay' k n := by have l1 : Continuous (fun x => ‖x‖ ^ k * ‖iteratedFDeriv ℝ n f x‖) := by have : ContDiff ℝ ∞ (iteratedFDeriv ℝ n f) := h1.iteratedFDeriv_right (mod_cast le_top) exact Continuous.mul (by continuity) this.continuous.norm have l2 : HasCompactSupport (fun x ↦ ‖x‖ ^ k * ‖iteratedFDeriv ℝ n f x‖) := (h2.iteratedFDeriv _).norm.mul_left simpa using l1.bounded_above_of_compact_support l2 lemma toSchwartz_apply (f : ℝ → ℂ) {h1 h2 x} : SchwartzMap.mk f h1 h2 x = f x := rfl lemma comp_exp_support0 {Ψ : ℝ → ℂ} (hplus : closure (Function.support Ψ) ⊆ Ioi 0) : ∀ᶠ x in 𝓝 0, Ψ x = 0 := notMem_tsupport_iff_eventuallyEq.mp (fun h => lt_irrefl 0 <| mem_Ioi.mp (hplus h)) lemma comp_exp_support1 {Ψ : ℝ → ℂ} (hplus : closure (Function.support Ψ) ⊆ Ioi 0) : ∀ᶠ x in atBot, Ψ (exp x) = 0 := Real.tendsto_exp_atBot <| comp_exp_support0 hplus lemma comp_exp_support2 {Ψ : ℝ → ℂ} (hsupp : HasCompactSupport Ψ) : ∀ᶠ (x : ℝ) in atTop, (Ψ ∘ rexp) x = 0 := by simp only [hasCompactSupport_iff_eventuallyEq, coclosedCompact_eq_cocompact, cocompact_eq_atBot_atTop] at hsupp exact Real.tendsto_exp_atTop hsupp.2 theorem comp_exp_support {Ψ : ℝ → ℂ} (hsupp : HasCompactSupport Ψ) (hplus : closure (Function.support Ψ) ⊆ Ioi 0) : HasCompactSupport (Ψ ∘ rexp) := by simp only [hasCompactSupport_iff_eventuallyEq, coclosedCompact_eq_cocompact, cocompact_eq_atBot_atTop] exact ⟨comp_exp_support1 hplus, comp_exp_support2 hsupp⟩ lemma wiener_ikehara_smooth_aux (l0 : Continuous Ψ) (hsupp : HasCompactSupport Ψ) (hplus : closure (Function.support Ψ) ⊆ Ioi 0) (x : ℝ) (hx : 0 < x) : ∫ (u : ℝ) in Ioi (-Real.log x), ↑(rexp u) * Ψ (rexp u) = ∫ (y : ℝ) in Ioi (1 / x), Ψ y := by have l1 : ContinuousOn rexp (Ici (-Real.log x)) := by fun_prop have l2 : Tendsto rexp atTop atTop := Real.tendsto_exp_atTop have l3 t (_ : t ∈ Ioi (-log x)) : HasDerivWithinAt rexp (rexp t) (Ioi t) t := (Real.hasDerivAt_exp t).hasDerivWithinAt have l4 : ContinuousOn Ψ (rexp '' Ioi (-Real.log x)) := by fun_prop have l5 : IntegrableOn Ψ (rexp '' Ici (-Real.log x)) volume := (l0.integrable_of_hasCompactSupport hsupp).integrableOn have l6 : IntegrableOn (fun x ↦ rexp x • (Ψ ∘ rexp) x) (Ici (-Real.log x)) volume := by refine (Continuous.integrable_of_hasCompactSupport (by fun_prop) ?_).integrableOn change HasCompactSupport (rexp • (Ψ ∘ rexp)) exact (comp_exp_support hsupp hplus).smul_left have := MeasureTheory.integral_deriv_smul_comp_Ioi l1 l2 l3 l4 l5 l6 simpa [Real.exp_neg, Real.exp_log hx, Complex.real_smul, smul_eq_mul] using this theorem wiener_ikehara_smooth_sub (h1 : Integrable Ψ) (hplus : closure (Function.support Ψ) ⊆ Ioi 0) : Tendsto (fun x ↦ (↑A * ∫ (y : ℝ) in Ioi x⁻¹, Ψ y) - ↑A * ∫ (y : ℝ) in Ioi 0, Ψ y) atTop (𝓝 0) := by obtain ⟨ε, hε, hh⟩ := Metric.eventually_nhds_iff.mp <| comp_exp_support0 hplus apply tendsto_nhds_of_eventually_eq ; filter_upwards [eventually_gt_atTop ε⁻¹] with x hxε have l1 : Integrable (indicator (Ioi x⁻¹) (fun x : ℝ => Ψ x)) := h1.indicator measurableSet_Ioi have l2 : Integrable (indicator (Ioi 0) (fun x : ℝ => Ψ x)) := h1.indicator measurableSet_Ioi simp_rw [← MeasureTheory.integral_indicator measurableSet_Ioi, ← mul_sub, ← integral_sub l1 l2] simp only [mul_eq_zero, ofReal_eq_zero] right apply MeasureTheory.integral_eq_zero_of_ae apply Eventually.of_forall intro t simp only [Pi.zero_apply] have hε' : 0 < ε⁻¹ := by positivity have hx : 0 < x := by linarith have hx' : 0 < x⁻¹ := by positivity have hεx : x⁻¹ < ε := (inv_lt_comm₀ hε hx).mp hxε have l3 : Ioi 0 = Ioc 0 x⁻¹ ∪ Ioi x⁻¹ := by ext t ; simp only [mem_Ioi, mem_union, mem_Ioc] ; constructor <;> intro h · simp [h, le_or_gt] · cases h with | inl h => exact h.1 | inr h => exact hx'.trans h have l4 : Disjoint (Ioc 0 x⁻¹) (Ioi x⁻¹) := by simp have l5 := Set.indicator_union_of_disjoint l4 Ψ rw [l3, l5] simp only rw [add_comm, sub_add_cancel_left] by_cases ht : t ∈ Ioc 0 x⁻¹ · simp only [ht, indicator_of_mem, neg_eq_zero] apply hh ; simp only [mem_Ioc, dist_zero_right, norm_eq_abs] at ht ⊢ apply hεx.trans_le' rw [abs_le] ; constructor <;> linarith simp [ht] lemma wiener_ikehara_smooth (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hcheby : cheby f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (hsmooth : ContDiff ℝ ∞ Ψ) (hsupp : HasCompactSupport Ψ) (hplus : closure (Function.support Ψ) ⊆ Set.Ioi 0) : Tendsto (fun x : ℝ ↦ (∑' n, f n * Ψ (n / x)) / x - A * ∫ y in Set.Ioi 0, Ψ y) atTop (𝓝 0) := by let h (x : ℝ) : ℂ := rexp (2 * π * x) * Ψ (exp (2 * π * x)) have h1 : ContDiff ℝ ∞ h := by have : ContDiff ℝ ∞ (fun x : ℝ => (rexp (2 * π * x))) := (contDiff_const.mul contDiff_id).exp exact (contDiff_ofReal.comp this).mul (hsmooth.comp this) have h2 : HasCompactSupport h := by have : 2 * π ≠ 0 := by simp [pi_ne_zero] simpa using! (comp_exp_support hsupp hplus).comp_smul this |>.mul_left obtain ⟨g, hg⟩ := fourier_surjection_on_schwartz (toSchwartz h h1 h2) have l1 {y} (hy : 0 < y) : y * Ψ y = 𝓕 g (1 / (2 * π) * Real.log y) := by simp only [one_div, mul_inv_rev, hg, toSchwartz, ofReal_exp, ofReal_mul, ofReal_ofNat, toSchwartz_apply, ofReal_inv, h] field_simp norm_cast rw [Real.exp_log hy] have key := limiting_cor_schwartz g hf hcheby hG hG' have l2 : ∀ᶠ x in atTop, ∑' (n : ℕ), f n / ↑n * 𝓕 g (1 / (2 * π) * Real.log (↑n / x)) = ∑' (n : ℕ), f n * Ψ (↑n / x) / x := by filter_upwards [eventually_gt_atTop 0] with x hx congr ; ext n by_cases hn : n = 0 · simp [hn, (comp_exp_support0 hplus).self_of_nhds] rw [← l1 (by positivity)] have : (n : ℂ) ≠ 0 := by simpa using hn have : (x : ℂ) ≠ 0 := by simpa using hx.ne.symm simp only [ofReal_div, ofReal_natCast] field_simp have l3 : ∀ᶠ x in atTop, ↑A * ∫ (u : ℝ) in Ici (-Real.log x), 𝓕 g (u / (2 * π)) = ↑A * ∫ (y : ℝ) in Ioi x⁻¹, Ψ y := by filter_upwards [eventually_gt_atTop 0] with x hx congr 1 simp only [hg, toSchwartz, ofReal_exp, ofReal_mul, ofReal_ofNat, toSchwartz_apply, ofReal_div, h] norm_cast ; field_simp; norm_cast rw [MeasureTheory.integral_Ici_eq_integral_Ioi] exact wiener_ikehara_smooth_aux hsmooth.continuous hsupp hplus x hx have l4 : Tendsto (fun x => (↑A * ∫ (y : ℝ) in Ioi x⁻¹, Ψ y) - ↑A * ∫ (y : ℝ) in Ioi 0, Ψ y) atTop (𝓝 0) := by exact wiener_ikehara_smooth_sub (hsmooth.continuous.integrable_of_hasCompactSupport hsupp) hplus simpa [tsum_div_const] using (key.congr' <| EventuallyEq.sub l2 l3) |>.add l4 lemma wiener_ikehara_smooth' (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hcheby : cheby f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (hsmooth : ContDiff ℝ ∞ Ψ) (hsupp : HasCompactSupport Ψ) (hplus : closure (Function.support Ψ) ⊆ Set.Ioi 0) : Tendsto (fun x : ℝ ↦ (∑' n, f n * Ψ (n / x)) / x) atTop (nhds (A * ∫ y in Set.Ioi 0, Ψ y)) := tendsto_sub_nhds_zero_iff.mp <| wiener_ikehara_smooth hf hcheby hG hG' hsmooth hsupp hplus theorem set_integral_ofReal {f : ℝ → ℝ} {s : Set ℝ} : ∫ x in s, (f x : ℂ) = ∫ x in s, f x := integral_ofReal lemma wiener_ikehara_smooth_real : letI := @realFunctionCoeDict ∀ {f : ℕ → ℝ} {Ψ : ℝ → ℝ} (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hcheby : cheby f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (hsmooth : ContDiff ℝ ∞ Ψ) (hsupp : HasCompactSupport Ψ) (hplus : closure (Function.support Ψ) ⊆ Set.Ioi 0), Tendsto (fun x : ℝ ↦ (∑' n, f n * Ψ (n / x)) / x) atTop (nhds (A * ∫ y in Set.Ioi 0, Ψ y)) := by letI := @realFunctionCoeDict intro f Ψ hf hcheby hG hG' hsmooth hsupp hplus let Ψ' := ofReal ∘ Ψ have l1 : ContDiff ℝ ∞ Ψ' := contDiff_ofReal.comp hsmooth have l2 : HasCompactSupport Ψ' := hsupp.comp_left rfl have l3 : closure (Function.support Ψ') ⊆ Ioi 0 := by rwa [Function.support_comp_eq] ; simp have key := (continuous_re.tendsto _).comp (@wiener_ikehara_smooth' A Ψ G f hf hcheby hG hG' l1 l2 l3) simp only [set_integral_ofReal] at key simp at key ; norm_cast at key lemma interval_approx_inf (ha : 0 < a) (hab : a < b) : ∀ᶠ ε in 𝓝[>] 0, ∃ ψ : ℝ → ℝ, ContDiff ℝ ∞ ψ ∧ HasCompactSupport ψ ∧ closure (Function.support ψ) ⊆ Set.Ioi 0 ∧ ψ ≤ indicator (Ico a b) 1 ∧ b - a - ε ≤ ∫ y in Ioi 0, ψ y := by have l1 : Iio ((b - a) / 3) ∈ 𝓝[>] 0 := nhdsWithin_le_nhds <| Iio_mem_nhds <| by rw [← sub_pos] at hab positivity filter_upwards [self_mem_nhdsWithin, l1] with ε (hε : 0 < ε) (hε' : ε < (b - a) / 3) have l2 : a < a + ε / 2 := by simp [hε] have l3 : b - ε / 2 < b := by simp [hε] obtain ⟨ψ, h1, h2, h3, h4, h5⟩ := smooth_urysohn_support_Ioo l2 l3 refine ⟨ψ, h1, h2, ?_, ?_, ?_⟩ · simp [h5, hab.ne, Icc_subset_Ioi_iff hab.le, ha] · exact h4.trans <| indicator_le_indicator_of_subset Ioo_subset_Ico_self (by simp) · have l4 : 0 ≤ b - a - ε := by linarith have l5 : Icc (a + ε / 2) (b - ε / 2) ⊆ Ioi 0 := by intro t ht simp only [mem_Icc, mem_Ioi] at ht ⊢ exact ha.trans <| l2.trans_le <| ht.1 have l6 : Icc (a + ε / 2) (b - ε / 2) ∩ Ioi 0 = Icc (a + ε / 2) (b - ε / 2) := inter_eq_left.mpr l5 have l7 : ∫ y in Ioi 0, indicator (Icc (a + ε / 2) (b - ε / 2)) 1 y = b - a - ε := by simp only [measurableSet_Icc, integral_indicator_one, measureReal_restrict_apply, l6, volume_real_Icc] convert max_eq_left l4 using 1 ; ring_nf have l8 : IntegrableOn ψ (Ioi 0) volume := (h1.continuous.integrable_of_hasCompactSupport h2).integrableOn rw [← l7] ; apply setIntegral_mono ?_ l8 h3 rw [IntegrableOn, integrable_indicator_iff measurableSet_Icc] apply IntegrableOn.mono ?_ subset_rfl Measure.restrict_le_self apply integrableOn_const <;> simp lemma interval_approx_sup (ha : 0 < a) (hab : a < b) : ∀ᶠ ε in 𝓝[>] 0, ∃ ψ : ℝ → ℝ, ContDiff ℝ ∞ ψ ∧ HasCompactSupport ψ ∧ closure (Function.support ψ) ⊆ Set.Ioi 0 ∧ indicator (Ico a b) 1 ≤ ψ ∧ ∫ y in Ioi 0, ψ y ≤ b - a + ε := by have l1 : Iio (a / 2) ∈ 𝓝[>] 0 := nhdsWithin_le_nhds <| Iio_mem_nhds (by linarith) filter_upwards [self_mem_nhdsWithin, l1] with ε (hε : 0 < ε) (hε' : ε < a / 2) have l2 : a - ε / 2 < a := by linarith have l3 : b < b + ε / 2 := by linarith obtain ⟨ψ, h1, h2, h3, h4, h5⟩ := smooth_urysohn_support_Ioo l2 l3 refine ⟨ψ, h1, h2, ?_, ?_, ?_⟩ · have l4 : a - ε / 2 < b + ε / 2 := by linarith have l5 : ε / 2 < a := by linarith simp [h5, l4.ne, Icc_subset_Ioi_iff l4.le, l5] · apply le_trans ?_ h3 apply indicator_le_indicator_of_subset Ico_subset_Icc_self (by simp) · have l4 : 0 ≤ b - a + ε := by linarith have l5 : Ioo (a - ε / 2) (b + ε / 2) ⊆ Ioi 0 := by intro t ht ; simp at ht ⊢ ; linarith have l6 : Ioo (a - ε / 2) (b + ε / 2) ∩ Ioi 0 = Ioo (a - ε / 2) (b + ε / 2) := inter_eq_left.mpr l5 have l7 : ∫ y in Ioi 0, indicator (Ioo (a - ε / 2) (b + ε / 2)) 1 y = b - a + ε := by simp only [measurableSet_Ioo, integral_indicator_one, measureReal_restrict_apply, l6, volume_real_Ioo] convert max_eq_left l4 using 1 ; ring_nf have l8 : IntegrableOn ψ (Ioi 0) volume := (h1.continuous.integrable_of_hasCompactSupport h2).integrableOn rw [← l7] refine setIntegral_mono l8 ?_ h4 rw [IntegrableOn, integrable_indicator_iff measurableSet_Ioo] apply IntegrableOn.mono ?_ subset_rfl Measure.restrict_le_self apply integrableOn_const <;> simp lemma WI_summable {f : ℕ → ℝ} {g : ℝ → ℝ} (hg : HasCompactSupport g) (hx : 0 < x) : Summable (fun n => f n * g (n / x)) := by obtain ⟨M, hM⟩ := hg.bddAbove.mono subset_closure apply summable_of_hasFiniteSupport unfold Function.HasFiniteSupport simp only [Function.support_mul] ; apply Finite.inter_of_right ; rw [finite_iff_bddAbove] exact ⟨Nat.ceil (M * x), fun i hi => by simpa using Nat.ceil_mono ((div_le_iff₀ hx).mp (hM hi))⟩ lemma WI_sum_le {f : ℕ → ℝ} {g₁ g₂ : ℝ → ℝ} (hf : 0 ≤ f) (hg : g₁ ≤ g₂) (hx : 0 < x) (hg₁ : HasCompactSupport g₁) (hg₂ : HasCompactSupport g₂) : (∑' n, f n * g₁ (n / x)) / x ≤ (∑' n, f n * g₂ (n / x)) / x := by apply div_le_div_of_nonneg_right ?_ hx.le exact Summable.tsum_le_tsum (fun n => mul_le_mul_of_nonneg_left (hg _) (hf _)) (WI_summable hg₁ hx) (WI_summable hg₂ hx) lemma WI_sum_Iab_le : letI := @realFunctionCoeDict ∀ {f : ℕ → ℝ} (hpos : 0 ≤ f) {C : ℝ} (hcheby : chebyWith C f) (hb : 0 < b) (hxb : 2 / b < x), (∑' n, f n * indicator (Ico a b) 1 (n / x)) / x ≤ C * 2 * b := by letI := @realFunctionCoeDict intro f hpos C hcheby hb hxb have hb' : 0 < 2 / b := by positivity have hx : 0 < x := by linarith have hxb' : 2 < x * b := (div_lt_iff₀ hb).mp hxb have l1 (i : ℕ) (hi : i ∉ Finset.range ⌈b * x⌉₊) : f i * indicator (Ico a b) 1 (i / x) = 0 := by simp_all [le_div_iff₀ hx] have l2 (i : ℕ) (_ : i ∈ Finset.range ⌈b * x⌉₊) : f i * indicator (Ico a b) 1 (i / x) ≤ |f i| := by rw [abs_eq_self.mpr (hpos _)] convert_to _ ≤ f i * 1 · ring apply mul_le_mul_of_nonneg_left ?_ (hpos _) by_cases hi : (i / x) ∈ (Ico a b) <;> simp [hi] rw [tsum_eq_sum l1, div_le_iff₀ hx, mul_assoc, mul_assoc] apply Finset.sum_le_sum l2 |>.trans have := hcheby ⌈b * x⌉₊ ; simp only [norm_real, norm_eq_abs] at this ; apply this.trans have : 0 ≤ C := by have := hcheby 1 ; simp only [cumsum, Finset.range_one, norm_real, Finset.sum_singleton, Nat.cast_one, mul_one] at this ; exact (abs_nonneg _).trans this refine mul_le_mul_of_nonneg_left ?_ this apply (Nat.ceil_lt_add_one (by positivity)).le.trans linarith lemma WI_sum_Iab_le' : letI := @realFunctionCoeDict ∀ {f : ℕ → ℝ} (hpos : 0 ≤ f) {C : ℝ} (hcheby : chebyWith C f) (hb : 0 < b), ∀ᶠ x : ℝ in atTop, (∑' n, f n * indicator (Ico a b) 1 (n / x)) / x ≤ C * 2 * b := by letI := @realFunctionCoeDict intro f hpos C hcheby hb filter_upwards [eventually_gt_atTop (2 / b)] with x hx using WI_sum_Iab_le hpos hcheby hb hx lemma le_of_eventually_nhdsWithin {a b : ℝ} (h : ∀ᶠ c in 𝓝[>] b, a ≤ c) : a ≤ b := by apply le_of_forall_gt ; intro d hd have key : ∀ᶠ c in 𝓝[>] b, c < d := by apply eventually_of_mem (U := Iio d) ?_ (fun x hx => hx) rw [mem_nhdsWithin] refine ⟨Iio d, isOpen_Iio, hd, inter_subset_left⟩ obtain ⟨x, h1, h2⟩ := (h.and key).exists linarith lemma ge_of_eventually_nhdsWithin {a b : ℝ} (h : ∀ᶠ c in 𝓝[<] b, c ≤ a) : b ≤ a := by apply le_of_forall_lt ; intro d hd have key : ∀ᶠ c in 𝓝[<] b, c > d := by apply eventually_of_mem (U := Ioi d) ?_ (fun x hx => hx) rw [mem_nhdsWithin] refine ⟨Ioi d, isOpen_Ioi, hd, inter_subset_left⟩ obtain ⟨x, h1, h2⟩ := (h.and key).exists linarith lemma WI_tendsto_aux (a b : ℝ) {A : ℝ} (hA : 0 < A) : Tendsto (fun c => c / A - (b - a)) (𝓝[>] (A * (b - a))) (𝓝[>] 0) := by rw [Metric.tendsto_nhdsWithin_nhdsWithin] intro ε hε refine ⟨A * ε, by positivity, ?_⟩ intro x hx1 hx2 constructor · simpa [lt_div_iff₀' hA] · simp only [Real.dist_eq, dist_zero_right, Real.norm_eq_abs] at hx2 ⊢ have : |x / A - (b - a)| = |x - A * (b - a)| / A := by rw [← abs_eq_self.mpr hA.le, ← abs_div, abs_eq_self.mpr hA.le] ; congr ; field_simp rwa [this, div_lt_iff₀' hA] lemma WI_tendsto_aux' (a b : ℝ) {A : ℝ} (hA : 0 < A) : Tendsto (fun c => (b - a) - c / A) (𝓝[<] (A * (b - a))) (𝓝[>] 0) := by rw [Metric.tendsto_nhdsWithin_nhdsWithin] intro ε hε refine ⟨A * ε, by positivity, ?_⟩ intro x hx1 hx2 constructor · simpa [div_lt_iff₀' hA] · simp only [Real.dist_eq, dist_zero_right, norm_eq_abs] at hx2 ⊢ have : |(b - a) - x / A| = |A * (b - a) - x| / A := by rw [← abs_eq_self.mpr hA.le, ← abs_div, abs_eq_self.mpr hA.le] ; congr ; field_simp rwa [this, div_lt_iff₀' hA, ← neg_sub, abs_neg] theorem residue_nonneg {f : ℕ → ℝ} (hpos : 0 ≤ f) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm (fun n ↦ ↑(f n)) σ')) (hcheby : cheby fun n ↦ ↑(f n)) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : EqOn G (fun s ↦ LSeries (fun n ↦ ↑(f n)) s - ↑A / (s - 1)) {s | 1 < s.re}) : 0 ≤ A := by let S (g : ℝ → ℝ) (x : ℝ) := (∑' n, f n * g (n / x)) / x have hSnonneg {g : ℝ → ℝ} (hg : 0 ≤ g) : ∀ᶠ x : ℝ in atTop, 0 ≤ S g x := by filter_upwards [eventually_ge_atTop 0] with x hx exact div_nonneg (tsum_nonneg (fun i => mul_nonneg (hpos _) (hg _))) hx obtain ⟨ε, ψ, h1, h2, h3, h4, -⟩ := (interval_approx_sup zero_lt_one one_lt_two).exists have key := @wiener_ikehara_smooth_real A G f ψ hf hcheby hG hG' h1 h2 h3 have l2 : 0 ≤ ψ := by apply le_trans _ h4 ; apply indicator_nonneg ; simp have l1 : ∀ᶠ x in atTop, 0 ≤ S ψ x := hSnonneg l2 have l3 : 0 ≤ A * ∫ (y : ℝ) in Ioi 0, ψ y := ge_of_tendsto key l1 have l4 : 0 < ∫ (y : ℝ) in Ioi 0, ψ y := by have r1 : 0 ≤ᵐ[Measure.restrict volume (Ioi 0)] ψ := Eventually.of_forall l2 have r2 : IntegrableOn (fun y ↦ ψ y) (Ioi 0) volume := (h1.continuous.integrable_of_hasCompactSupport h2).integrableOn have r3 : Ico 1 2 ⊆ Function.support ψ := by intro x hx ; have := h4 x ; simp [hx] at this ⊢ ; linarith have r4 : Ico 1 2 ⊆ Function.support ψ ∩ Ioi 0 := by simp only [subset_inter_iff, r3, true_and] ; apply Ico_subset_Icc_self.trans ; rw [Icc_subset_Ioi_iff] <;> linarith have r5 : 1 ≤ volume ((Function.support fun y ↦ ψ y) ∩ Ioi 0) := by convert! volume.mono r4 ; norm_num simpa [setIntegral_pos_iff_support_of_nonneg_ae r1 r2] using! zero_lt_one.trans_le r5 have := div_nonneg l3 l4.le ; field_simp at this ; exact this lemma WienerIkeharaInterval : letI := @realFunctionCoeDict ∀ {f : ℕ → ℝ} (hpos : 0 ≤ f) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hcheby : cheby f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (ha : 0 < a) (hb : a ≤ b), Tendsto (fun x : ℝ ↦ (∑' n, f n * (indicator (Ico a b) 1 (n / x))) / x) atTop (nhds (A * (b - a))) := by letI := @realFunctionCoeDict intro f hpos hf hcheby hG hG' ha hb -- Take care of the trivial case `a = b` by_cases hab : a = b · simp [hab] replace hb : a < b := lt_of_le_of_ne hb hab ; clear hab -- Notation to make the proof more readable let S (g : ℝ → ℝ) (x : ℝ) := (∑' n, f n * g (n / x)) / x have hSnonneg {g : ℝ → ℝ} (hg : 0 ≤ g) : ∀ᶠ x : ℝ in atTop, 0 ≤ S g x := by filter_upwards [eventually_ge_atTop 0] with x hx refine div_nonneg ?_ hx refine tsum_nonneg (fun i => mul_nonneg (hpos _) (hg _)) have hA : 0 ≤ A := residue_nonneg hpos hf hcheby hG hG' -- A few facts about the indicator function of `Icc a b` let Iab : ℝ → ℝ := indicator (Ico a b) 1 change Tendsto (S Iab) atTop (𝓝 (A * (b - a))) have hIab : HasCompactSupport Iab := by simpa [Iab, HasCompactSupport, tsupport, hb.ne] using isCompact_Icc have Iab_nonneg : ∀ᶠ x : ℝ in atTop, 0 ≤ S Iab x := hSnonneg (indicator_nonneg (by simp)) have Iab2 : IsBoundedUnder (· ≤ ·) atTop (S Iab) := by obtain ⟨C, hC⟩ := hcheby ; exact ⟨C * 2 * b, WI_sum_Iab_le' hpos hC (by linarith)⟩ have Iab3 : IsBoundedUnder (· ≥ ·) atTop (S Iab) := ⟨0, Iab_nonneg⟩ have Iab0 : IsCoboundedUnder (· ≥ ·) atTop (S Iab) := Iab2.isCoboundedUnder_ge have Iab1 : IsCoboundedUnder (· ≤ ·) atTop (S Iab) := Iab3.isCoboundedUnder_le -- Bound from above by a smooth function have sup_le : limsup (S Iab) atTop ≤ A * (b - a) := by have l_sup : ∀ᶠ ε in 𝓝[>] 0, limsup (S Iab) atTop ≤ A * (b - a + ε) := by filter_upwards [interval_approx_sup ha hb] with ε ⟨ψ, h1, h2, h3, h4, h6⟩ have l1 : Tendsto (S ψ) atTop _ := wiener_ikehara_smooth_real hf hcheby hG hG' h1 h2 h3 have l6 : S Iab ≤ᶠ[atTop] S ψ := by filter_upwards [eventually_gt_atTop 0] with x hx using WI_sum_le hpos h4 hx hIab h2 have l5 : IsBoundedUnder (· ≤ ·) atTop (S ψ) := l1.isBoundedUnder_le have l3 : limsup (S Iab) atTop ≤ limsup (S ψ) atTop := limsup_le_limsup l6 Iab1 l5 apply l3.trans ; rw [l1.limsup_eq] ; gcongr obtain rfl | h := eq_or_ne A 0 · simpa using l_sup apply le_of_eventually_nhdsWithin have key : 0 < A := lt_of_le_of_ne hA h.symm filter_upwards [WI_tendsto_aux a b key l_sup] with x hx simpa [mul_div_cancel₀ _ h] using hx -- Bound from below by a smooth function have le_inf : A * (b - a) ≤ liminf (S Iab) atTop := by have l_inf : ∀ᶠ ε in 𝓝[>] 0, A * (b - a - ε) ≤ liminf (S Iab) atTop := by filter_upwards [interval_approx_inf ha hb] with ε ⟨ψ, h1, h2, h3, h5, h6⟩ have l1 : Tendsto (S ψ) atTop _ := wiener_ikehara_smooth_real hf hcheby hG hG' h1 h2 h3 have l2 : S ψ ≤ᶠ[atTop] S Iab := by filter_upwards [eventually_gt_atTop 0] with x hx using WI_sum_le hpos h5 hx h2 hIab have l4 : IsBoundedUnder (· ≥ ·) atTop (S ψ) := l1.isBoundedUnder_ge have l3 : liminf (S ψ) atTop ≤ liminf (S Iab) atTop := liminf_le_liminf l2 l4 Iab0 apply le_trans ?_ l3 ; rw [l1.liminf_eq] ; gcongr obtain rfl | h := eq_or_ne A 0 · simpa using l_inf apply ge_of_eventually_nhdsWithin have key : 0 < A := lt_of_le_of_ne hA h.symm filter_upwards [WI_tendsto_aux' a b key l_inf] with x hx simpa [mul_div_cancel₀ _ h] using hx -- Combine the two bounds have : liminf (S Iab) atTop ≤ limsup (S Iab) atTop := liminf_le_limsup Iab2 Iab3 refine tendsto_of_liminf_eq_limsup ?_ ?_ Iab2 Iab3 <;> linarith lemma le_floor_mul_iff (hb : 0 ≤ b) (hx : 0 < x) : n ≤ ⌊b * x⌋₊ ↔ n / x ≤ b := by rw [div_le_iff₀ hx, Nat.le_floor_iff] ; positivity lemma lt_ceil_mul_iff (hx : 0 < x) : n < ⌈b * x⌉₊ ↔ n / x < b := by rw [div_lt_iff₀ hx, Nat.lt_ceil] lemma ceil_mul_le_iff (hx : 0 < x) : ⌈a * x⌉₊ ≤ n ↔ a ≤ n / x := by rw [le_div_iff₀ hx, Nat.ceil_le] lemma mem_Icc_iff_div (hb : 0 ≤ b) (hx : 0 < x) : n ∈ Finset.Icc ⌈a * x⌉₊ ⌊b * x⌋₊ ↔ n / x ∈ Icc a b := by rw [Finset.mem_Icc, mem_Icc, ceil_mul_le_iff hx, le_floor_mul_iff hb hx] lemma mem_Ico_iff_div (hx : 0 < x) : n ∈ Finset.Ico ⌈a * x⌉₊ ⌈b * x⌉₊ ↔ n / x ∈ Ico a b := by rw [Finset.mem_Ico, mem_Ico, ceil_mul_le_iff hx, lt_ceil_mul_iff hx] lemma tsum_indicator {f : ℕ → ℝ} (hx : 0 < x) : ∑' n, f n * (indicator (Ico a b) 1 (n / x)) = ∑ n ∈ Finset.Ico ⌈a * x⌉₊ ⌈b * x⌉₊, f n := by have l1 : ∀ n ∉ Finset.Ico ⌈a * x⌉₊ ⌈b * x⌉₊, f n * indicator (Ico a b) 1 (↑n / x) = 0 := by simp [mem_Ico_iff_div hx] ; tauto rw [tsum_eq_sum l1] ; apply Finset.sum_congr rfl ; simp only [mem_Ico_iff_div hx] ; intro n hn ; simp [hn] lemma WienerIkeharaInterval_discrete : letI := @realFunctionCoeDict ∀ {f : ℕ → ℝ} (hpos : 0 ≤ f) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hcheby : cheby f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (ha : 0 < a) (hb : a ≤ b), Tendsto (fun x : ℝ ↦ (∑ n ∈ Finset.Ico ⌈a * x⌉₊ ⌈b * x⌉₊, f n) / x) atTop (nhds (A * (b - a))) := by letI := @realFunctionCoeDict intro f hpos hf hcheby hG hG' ha hb apply (WienerIkeharaInterval hpos hf hcheby hG hG' ha hb).congr' filter_upwards [eventually_gt_atTop 0] with x hx rw [tsum_indicator hx] lemma WienerIkeharaInterval_discrete' : letI := @realFunctionCoeDict ∀ {f : ℕ → ℝ} (hpos : 0 ≤ f) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hcheby : cheby f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (ha : 0 < a) (hb : a ≤ b), Tendsto (fun N : ℕ ↦ (∑ n ∈ Finset.Ico ⌈a * N⌉₊ ⌈b * N⌉₊, f n) / N) atTop (nhds (A * (b - a))) := by letI := @realFunctionCoeDict intro f hpos hf hcheby hG hG' ha hb exact WienerIkeharaInterval_discrete hpos hf hcheby hG hG' ha hb |>.comp tendsto_natCast_atTop_atTop -- TODO with `Ico` /-- A version of the *Wiener-Ikehara Tauberian Theorem*: If `f` is a nonnegative arithmetic function whose L-series has a simple pole at `s = 1` with residue `A` and otherwise extends continuously to the closed half-plane `re s ≥ 1`, then `∑ n < N, f n` is asymptotic to `A*N`. -/ lemma tendsto_mul_ceil_div : Tendsto (fun (p : ℝ × ℕ) => ⌈p.1 * p.2⌉₊ / (p.2 : ℝ)) (𝓝[>] 0 ×ˢ atTop) (𝓝 0) := by rw [Metric.tendsto_nhds] ; intro δ hδ have l1 : ∀ᶠ ε : ℝ in 𝓝[>] 0, ε ∈ Ioo 0 (δ / 2) := inter_mem_nhdsWithin _ (Iio_mem_nhds (by positivity)) have l2 : ∀ᶠ N : ℕ in atTop, 1 ≤ δ / 2 * N := by apply Tendsto.eventually_ge_atTop exact tendsto_natCast_atTop_atTop.const_mul_atTop (by positivity) filter_upwards [l1.prod_mk l2] with (ε, N) ⟨⟨hε, h1⟩, h2⟩ ; dsimp only at * have l3 : 0 < (N : ℝ) := by simp only [Nat.cast_pos, Nat.pos_iff_ne_zero] ; rintro rfl ; simp [zero_lt_one.not_ge] at h2 have l5 : 0 ≤ ε * ↑N := by positivity have l6 : ε * N ≤ δ / 2 * N := mul_le_mul h1.le le_rfl (by positivity) (by positivity) simp only [dist_zero_right, norm_div, RCLike.norm_natCast, div_lt_iff₀ l3, gt_iff_lt] convert (Nat.ceil_lt_add_one l5).trans_le (add_le_add l6 h2) using 1 ; ring noncomputable def S (f : ℕ → 𝕜) (ε : ℝ) (N : ℕ) : 𝕜 := (∑ n ∈ Finset.Ico ⌈ε * N⌉₊ N, f n) / N lemma S_sub_S {f : ℕ → 𝕜} {ε : ℝ} {N : ℕ} (hε : ε ≤ 1) : S f 0 N - S f ε N = cumsum f ⌈ε * N⌉₊ / N := by have hceilN : ⌈ε * N⌉₊ ≤ N := by simp only [Nat.ceil_le] exact mul_le_of_le_one_left N.cast_nonneg hε have r1 : Finset.range N = Finset.range ⌈ε * N⌉₊ ∪ Finset.Ico ⌈ε * N⌉₊ N := by ext n simp only [Finset.mem_range, Finset.mem_union, Finset.mem_Ico] omega have r2 : Disjoint (Finset.range ⌈ε * N⌉₊) (Finset.Ico ⌈ε * N⌉₊ N) := by rw [Finset.range_eq_Ico] ; apply Finset.Ico_disjoint_Ico_consecutive simp [S, r1, Finset.sum_union r2, cumsum, add_div] lemma tendsto_S_S_zero : letI := @realFunctionCoeDict ∀ {f : ℕ → ℝ} (hpos : 0 ≤ f) (hcheby : cheby f), TendstoUniformlyOnFilter (S f) (S f 0) (𝓝[>] 0) atTop := by letI := @realFunctionCoeDict intro f hpos hcheby rw [Metric.tendstoUniformlyOnFilter_iff] ; intro δ hδ obtain ⟨C, hC⟩ := hcheby have l1 : ∀ᶠ (p : ℝ × ℕ) in 𝓝[>] 0 ×ˢ atTop, C * ⌈p.1 * p.2⌉₊ / p.2 < δ := by have r1 := tendsto_mul_ceil_div.const_mul C simp only [mul_div_assoc', mul_zero] at r1 ; exact r1 (Iio_mem_nhds hδ) have : Ioc 0 1 ∈ 𝓝[>] (0 : ℝ) := inter_mem_nhdsWithin _ (Iic_mem_nhds zero_lt_one) filter_upwards [l1, Eventually.prod_inl this _] with (ε, N) h1 h2 have l2 : ‖cumsum f ⌈ε * ↑N⌉₊ / ↑N‖ ≤ C * ⌈ε * N⌉₊ / N := by have r1 := hC ⌈ε * N⌉₊ have r2 : 0 ≤ cumsum f ⌈ε * N⌉₊ := by apply cumsum_nonneg hpos simp only [norm_real, norm_of_nonneg (hpos _), norm_div, norm_of_nonneg r2, Real.norm_natCast] at r1 ⊢ apply div_le_div_of_nonneg_right r1 (by positivity) simpa [← S_sub_S h2.2] using! l2.trans_lt h1 theorem WienerIkeharaTheorem' : letI := @realFunctionCoeDict ∀ {f : ℕ → ℝ} (hpos : 0 ≤ f) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hcheby : cheby f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}), Tendsto (fun N => cumsum f N / N) atTop (𝓝 A) := by letI := @realFunctionCoeDict intro f hpos hf hcheby hG hG' convert_to Tendsto (S f 0) atTop (𝓝 A) ; · ext N ; simp [S, cumsum] apply (tendsto_S_S_zero hpos hcheby).tendsto_of_eventually_tendsto · have L0 : Ioc 0 1 ∈ 𝓝[>] (0 : ℝ) := inter_mem_nhdsWithin _ (Iic_mem_nhds zero_lt_one) apply eventually_of_mem L0 · intro ε hε simpa using! WienerIkeharaInterval_discrete' hpos hf hcheby hG hG' hε.1 hε.2 · have : Tendsto (fun ε : ℝ => ε) (𝓝[>] 0) (𝓝 0) := nhdsWithin_le_nhds simpa using (this.const_sub 1).const_mul A theorem vonMangoldt_cheby : letI := @realFunctionCoeDict cheby Λ := by letI := @realFunctionCoeDict use Real.log 4 + 4 intro N by_cases! h : N = 0 · simp [h, cumsum] simp only [cumsum, norm_real, norm_eq_abs] rw [Nat.range_eq_Icc_zero_sub_one _ h, (by simp : N - 1 = ⌊(N : ℝ) - 1⌋₊)] simp_rw [abs_of_nonneg vonMangoldt_nonneg] rw [← Chebyshev.psi_eq_sum_Icc] grw [Chebyshev.psi_le_const_mul_self <| sub_nonneg_of_le <| Nat.one_le_cast_iff_ne_zero.mpr h] gcongr linarith theorem WeakPNT : Tendsto (fun N ↦ cumsum Λ N / N) atTop (𝓝 1) := by letI := @realFunctionCoeDict let F := vonMangoldt.LFunctionResidueClassAux (q := 1) 1 have hnv := riemannZeta_ne_zero_of_one_le_re have l1 (n : ℕ) : 0 ≤ Λ n := vonMangoldt_nonneg have l2 s (hs : 1 < s.re) : F s = LSeries Λ s - 1 / (s - 1) := by have := vonMangoldt.eqOn_LFunctionResidueClassAux (q := 1) isUnit_one hs simp only [F, this, vonMangoldt.residueClass, Nat.totient_one, Nat.cast_one, inv_one, one_div, sub_left_inj] apply LSeries_congr intro n _ simp only [ofReal_inj, indicator_apply_eq_self, mem_setOf_eq] exact fun hn ↦ absurd (Subsingleton.eq_one _) hn have l3 : ContinuousOn F {s | 1 ≤ s.re} := vonMangoldt.continuousOn_LFunctionResidueClassAux 1 have l4 : cheby Λ := vonMangoldt_cheby have l5 (σ' : ℝ) (hσ' : 1 < σ') : Summable (nterm Λ σ') := by simpa only [← nterm_eq_norm_term] using (@ArithmeticFunction.LSeriesSummable_vonMangoldt σ' hσ').norm apply WienerIkeharaTheorem' l1 l5 l4 l3 l2 -- #print axioms WeakPNT section auto_cheby variable {f : ℕ → ℝ} lemma norm_x_cpow_it (x t : ℝ) (hx : 0 < x) : ‖(x : ℂ) ^ (t * I)‖ = 1 := by rw [cpow_def_of_ne_zero <| ofReal_ne_zero.mpr hx.ne', ← ofReal_log hx.le] convert norm_exp_ofReal_mul_I (t * x.log) using 2 push_cast; ring_nf lemma limiting_fourier_aux_gt_zero : letI := @CS.coeFunDict letI := @realFunctionCoeDict ∀ (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (ψ : CS 2 ℂ) (hx : 0 < x) (σ' : ℝ) (hσ' : 1 < σ'), ∑' n, term f σ' n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * log (n / x)) - A * (x ^ (1 - σ') : ℝ) * ∫ u in Ici (- log x), rexp (-u * (σ' - 1)) * 𝓕 (ψ : ℝ → ℂ) (u / (2 * π)) = ∫ t : ℝ, G (σ' + t * I) * ψ t * x ^ (t * I) := by letI := @CS.coeFunDict letI := @realFunctionCoeDict letI := @W1.coeFunDict letI := @W21.csDict intro hG' hf ψ hx σ' hσ' have hint : Integrable ψ := ψ.h1.continuous.integrable_of_hasCompactSupport ψ.h2 have l8 : Continuous fun t : ℝ ↦ (x : ℂ) ^ (t * I) := continuous_const.cpow (continuous_ofReal.mul continuous_const) (by simp [hx]) have l4 : Integrable fun t : ℝ ↦ LSeries f (↑σ' + ↑t * I) * ψ t * ↑x ^ (↑t * I) := (((continuous_LSeries_aux (hf _ hσ')).mul ψ.h1.continuous).mul l8).integrable_of_hasCompactSupport ψ.h2.mul_left.mul_right have e2 (u : ℝ) : σ' + u * I - 1 ≠ 0 := fun h ↦ by have := congrArg Complex.re (sub_eq_zero.mp h); simp at this; linarith have l5 : Integrable fun a ↦ A * ↑(x ^ (1 - σ')) * (↑(x ^ (σ' - 1)) * (1 / (σ' + a * I - 1) * ψ a * x ^ (a * I))) := by have : Continuous fun a ↦ A * ↑(x ^ (1 - σ')) * (↑(x ^ (σ' - 1)) * (1 / (σ' + a * I - 1) * ψ a * x ^ (a * I))) := by simp only [one_div, ← mul_assoc] exact ((continuous_const.mul (Continuous.inv₀ (by fun_prop) e2)).mul ψ.h1.continuous).mul l8 exact this.integrable_of_hasCompactSupport ψ.h2.mul_left.mul_right.mul_left.mul_left simp_rw [first_fourier hf hint hx hσ', second_fourier ψ.h1.continuous.measurable hint hx hσ', ← integral_const_mul, ← integral_sub l4 l5] refine integral_congr_ae (.of_forall fun u ↦ ?_) have e1 : 1 < ((σ' : ℂ) + (u : ℂ) * I).re := by simp [hσ'] simp_rw [hG' e1, sub_mul, ← mul_assoc] simp only [one_div, sub_right_inj, mul_eq_mul_right_iff, cpow_eq_zero_iff, ofReal_eq_zero, ne_eq, mul_eq_zero, I_ne_zero, or_false] field_simp [e2]; norm_cast; simp [mul_assoc, ← rpow_add hx] theorem limiting_fourier_lim2_gt_zero : letI := @W1.coeFunDict ∀ (A : ℝ) (ψ : W21) (hx : 0 < x), Tendsto (fun σ' ↦ A * ↑(x ^ (1 - σ')) * ∫ u in Ici (-Real.log x), rexp (-u * (σ' - 1)) * 𝓕 (ψ : ℝ → ℂ) (u / (2 * π))) (𝓝[>] 1) (𝓝 (A * ∫ u in Ici (-Real.log x), 𝓕 (ψ : ℝ → ℂ) (u / (2 * π)))) := by letI := @W1.coeFunDict intro A ψ hx obtain ⟨C, hC⟩ := decay_bounds_cor ψ have hfourier_cont := continuous_FourierIntegral ψ refine Tendsto.mul ?_ (tendsto_integral_filter_of_dominated_convergence _ (.of_forall fun _ ↦ (by continuity : Continuous _).aestronglyMeasurable) ?_ (limiting_fourier_lim2_aux x C) (.of_forall fun u ↦ ?_)) · suffices Tendsto (fun σ' : ℝ ↦ x ^ (1 - σ')) (𝓝[>] 1) (𝓝 1) by simpa using ((continuous_ofReal.tendsto 1).comp this).const_mul ↑A have : Tendsto (fun σ' : ℝ ↦ 1 - σ') (𝓝[>] 1) (𝓝 0) := tendsto_nhdsWithin_of_tendsto_nhds (by simpa using (continuous_id.tendsto (1 : ℝ)).const_sub 1) simpa using tendsto_const_nhds.rpow this (Or.inl hx.ne') · refine eventually_of_mem (Ioo_mem_nhdsGT_of_mem (by norm_num : (1 : ℝ) ∈ Set.Ico 1 2)) fun σ' hσ' ↦ ?_ obtain ⟨h1, h2⟩ := hσ' rw [ae_restrict_iff' measurableSet_Ici] refine .of_forall fun t ht ↦ ?_ simp only [norm_mul, neg_mul, ofReal_exp, ofReal_neg, ofReal_mul, ofReal_sub, ofReal_one, norm_exp, neg_re, mul_re, ofReal_re, sub_re, one_re, ofReal_im, sub_im, one_im, sub_self, mul_zero, sub_zero] refine mul_le_mul ?_ (hC _) (norm_nonneg _) ((abs_nonneg x).trans (le_max_left _ _)) have hα0 : 0 ≤ σ' - 1 := by linarith have hα1 : σ' - 1 ≤ 1 := by linarith have hmul1 : (-x.log) * (σ' - 1) ≤ t * (σ' - 1) := mul_le_mul_of_nonneg_right ht hα0 calc Real.exp (-(t * (σ' - 1))) ≤ Real.exp (x.log * (σ' - 1)) := Real.exp_monotone (by linarith) _ ≤ max |x| 1 := by by_cases hx1 : 1 ≤ x · calc _ ≤ Real.exp x.log := Real.exp_monotone (mul_le_of_le_one_right (Real.log_nonneg hx1) hα1) _ = |x| := by rw [Real.exp_log hx, abs_of_pos hx] _ ≤ _ := le_max_left _ _ · calc _ ≤ 1 := (Real.exp_monotone (mul_nonpos_of_nonpos_of_nonneg ((Real.log_neg_iff hx).2 (by linarith)).le hα0)).trans_eq Real.exp_zero _ ≤ _ := le_max_right _ _ · suffices Tendsto (fun n ↦ ((rexp (-u * (n - 1))) : ℂ)) (𝓝[>] 1) (𝓝 1) by simpa using this.mul_const _ refine Tendsto.mono_left ?_ nhdsWithin_le_nhds have : Continuous (fun n ↦ ((rexp (-u * (n - 1))) : ℂ)) := by continuity simpa using this.tendsto 1 theorem limiting_fourier_lim3_gt_zero : letI := @CS.coeFunDict ∀ (hG : ContinuousOn G {s | 1 ≤ s.re}) (ψ : CS 2 ℂ) (hx : 0 < x), Tendsto (fun σ' : ℝ ↦ ∫ t : ℝ, G (σ' + t * I) * ψ t * x ^ (t * I)) (𝓝[>] 1) (𝓝 (∫ t : ℝ, G (1 + t * I) * ψ t * x ^ (t * I))) := by letI := @CS.coeFunDict letI := @W1.coeFunDict letI := @W21.csDict intro hG ψ hx by_cases hh : tsupport ψ = ∅ · simp [tsupport_eq_empty_iff.mp hh] obtain ⟨a₀, ha₀⟩ := Set.nonempty_iff_ne_empty.mpr hh let S : Set ℂ := reProdIm (Icc 1 2) (tsupport ψ) have l1 : IsCompact S := Metric.isCompact_iff_isClosed_bounded.mpr ⟨isClosed_Icc.reProdIm (isClosed_tsupport ψ), (Metric.isBounded_Icc 1 2).reProdIm ψ.h2.isBounded⟩ have l2 : S ⊆ {s : ℂ | 1 ≤ s.re} := fun z hz => (mem_reProdIm.mp hz).1.1 obtain ⟨z, -, hmax⟩ := l1.exists_isMaxOn ⟨1 + a₀ * I, by simp [S, mem_reProdIm, ha₀]⟩ (hG.mono l2).norm have hxC : (x : ℂ) ≠ 0 := ofReal_ne_zero.mpr hx.ne' refine tendsto_integral_filter_of_dominated_convergence (bound := fun a ↦ ‖G z‖ * ‖ψ a‖) (eventually_of_mem (Icc_mem_nhdsGT_of_mem (by norm_num : (1 : ℝ) ∈ Set.Ico 1 2)) fun u hu ↦ ((hG.comp_continuous (by fun_prop) (by simp [hu.1])).mul ψ.h1.continuous).mul (by simpa using Continuous.const_cpow (by fun_prop) (Or.inl hxC)) |>.aestronglyMeasurable) (eventually_of_mem (Icc_mem_nhdsGT_of_mem (by norm_num : (1 : ℝ) ∈ Set.Ico 1 2)) fun u hu ↦ .of_forall fun v ↦ ?_) ((continuous_const.mul ψ.h1.continuous.norm).integrable_of_hasCompactSupport ψ.h2.norm.mul_left) (.of_forall fun t ↦ ?_) · by_cases h : v ∈ tsupport ψ · simp_rw [norm_mul, norm_x_cpow_it x v hx, mul_one] exact mul_le_mul_of_nonneg_right (isMaxOn_iff.mp hmax _ (by simp [S, mem_reProdIm, hu.1, hu.2, h])) (norm_nonneg _) · have : v ∉ Function.support ψ := fun a ↦ h (subset_tsupport ψ a) simp [Function.notMem_support.mp this] · exact ((hG (1 + t * I) (by simp)).tendsto.comp <| tendsto_nhdsWithin_iff.mpr ⟨((continuous_ofReal.tendsto _).add tendsto_const_nhds).mono_left nhdsWithin_le_nhds, eventually_nhdsWithin_of_forall fun _ hx' ↦ by simp [(Set.mem_Ioi.mp hx').le]⟩).mul_const _ |>.mul_const _ lemma tendsto_tsum_of_monotone_convergence {β : Type*} {f : ℕ → β → ENNReal} {g : β → ENNReal} (hmono : ∀ k, Monotone (fun n => f n k)) (hlim : ∀ k, Tendsto (fun n => f n k) atTop (𝓝 (g k))) : Tendsto (fun n => ∑' k, f n k) atTop (𝓝 (∑' k, g k)) := by letI : MeasurableSpace β := ⊤ let μ : Measure β := Measure.count have hg_iSup (k : β) : (⨆ n : ℕ, f n k) = g k := iSup_eq_of_tendsto (hmono k) (hlim k) have h_tend_lint : Tendsto (fun n => ∫⁻ k, f n k ∂μ) atTop (𝓝 (∫⁻ k, (⨆ n, f n k) ∂μ)) := by have hmeas : ∀ n, Measurable fun k : β => f n k := fun _ _ _ ↦ trivial have hmono_fn : Monotone (fun n => fun k : β => f n k) := fun _ _ hnm k ↦ hmono k hnm simpa [lintegral_iSup hmeas hmono_fn] using tendsto_atTop_iSup fun _ _ hmn ↦ lintegral_mono fun k ↦ hmono k hmn simpa [μ, lintegral_count, hg_iSup] using h_tend_lint lemma tendsto_tsum_of_monotone_convergence_nhdsGT_one {F : ℝ → ℕ → ℝ} (hF_nonneg : ∀ σ n, 0 ≤ F σ n) (hF_antitone : ∀ n, AntitoneOn (fun σ : ℝ => F σ n) (Set.Ioi (1 : ℝ))) (hF_tend : ∀ n, Tendsto (fun σ : ℝ => F σ n) (𝓝[>] (1 : ℝ)) (𝓝 (F 1 n))) (hSumm : ∀ σ, 1 < σ → Summable (fun n : ℕ => F σ n)) (hbounded : BoundedAtFilter (𝓝[>] (1 : ℝ)) (fun σ : ℝ => (∑' n : ℕ, F σ n))) : Tendsto (fun σ : ℝ => ∑' n : ℕ, F σ n) (𝓝[>] (1 : ℝ)) (𝓝 (∑' n : ℕ, F 1 n)) := by let T : ℝ → ℝ := fun σ => ∑' n : ℕ, F σ n have hT_antitone : AntitoneOn T (Set.Ioi (1 : ℝ)) := fun a ha b hb hab ↦ (hSumm b hb).tsum_le_tsum_of_inj (fun n ↦ n) (fun _ _ h ↦ h) (fun c hc ↦ (hc ⟨c, rfl⟩).elim) (fun n ↦ hF_antitone n ha hb hab) (hSumm a ha) have hT_bdd : BddAbove (T '' Set.Ioi (1 : ℝ)) := by obtain ⟨C, hC⟩ := isBigO_iff.1 hbounded have hC' : ∀ᶠ σ : ℝ in 𝓝[>] (1 : ℝ), T σ ≤ C := by filter_upwards [hC] with σ hσ calc T σ ≤ |T σ| := le_abs_self _ _ = ‖T σ‖ := (Real.norm_eq_abs _).symm _ ≤ C * ‖(1 : ℝ → ℝ) σ‖ := hσ _ = C := by simp obtain ⟨U, hU, V, hV, hUV⟩ := Filter.mem_inf_iff_superset.1 hC' obtain ⟨ε, hε, hball⟩ := Metric.mem_nhds_iff.1 hU have hIoi_sub : Set.Ioi (1 : ℝ) ⊆ V := Filter.mem_principal.mp hV have hUsub : U ∩ Set.Ioi (1 : ℝ) ⊆ {σ : ℝ | T σ ≤ C} := fun σ hσ ↦ hUV ⟨hσ.1, hIoi_sub hσ.2⟩ have hσ0_Ioi : 1 + ε / 2 ∈ Set.Ioi (1 : ℝ) := by simp [half_pos hε] have hσ0_leC : T (1 + ε / 2) ≤ C := hUsub ⟨hball (by simp only [Metric.mem_ball, Real.dist_eq, add_sub_cancel_left, abs_of_pos (half_pos hε)]; exact half_lt_self hε), hσ0_Ioi⟩ refine ⟨C, ?_⟩ rintro _ ⟨σ, hσIoi, rfl⟩ by_cases hσlt : σ < 1 + ε / 2 · exact hUsub ⟨hball (by simp only [Metric.mem_ball, Real.dist_eq] rw [abs_of_pos (sub_pos.2 (Set.mem_Ioi.mp hσIoi))] linarith [half_lt_self hε]), hσIoi⟩ · exact (hT_antitone hσ0_Ioi hσIoi (le_of_not_gt hσlt)).trans hσ0_leC have hT_tend_sup : Tendsto T (𝓝[>] (1 : ℝ)) (𝓝 (sSup (T '' Set.Ioi (1 : ℝ)))) := hT_antitone.tendsto_nhdsGT hT_bdd let σseq : ℕ → ℝ := fun k => 1 + 1 / (k + 1 : ℝ) have hσseq_mem (k) : σseq k ∈ Set.Ioi (1 : ℝ) := by simp only [σseq, Set.mem_Ioi, lt_add_iff_pos_right] positivity have hσseq_tend_nhds : Tendsto σseq atTop (𝓝 (1 : ℝ)) := by have : Tendsto (fun k : ℕ => (1 : ℝ) + ((k + 1 : ℕ) : ℝ)⁻¹) atTop (𝓝 ((1 : ℝ) + 0)) := tendsto_const_nhds.add (tendsto_inv_atTop_nhds_zero_nat.comp (tendsto_add_atTop_nat 1)) simp only [add_zero] at this convert this using 1; ext k; simp [σseq, one_div] have hσseq_tend_nhdsWithin : Tendsto σseq atTop (𝓝[>] (1 : ℝ)) := tendsto_nhdsWithin_of_tendsto_nhds_of_eventually_within _ hσseq_tend_nhds (.of_forall hσseq_mem) have hσseq_antitone : Antitone σseq := fun k₁ k₂ hk ↦ by simp only [σseq]; gcongr have hmono_seq (n) : Monotone (fun k => F (σseq k) n) := fun k₁ k₂ hk ↦ hF_antitone n (hσseq_mem k₂) (hσseq_mem k₁) (hσseq_antitone hk) have htend_seq (n) : Tendsto (fun k => F (σseq k) n) atTop (𝓝 (F 1 n)) := (hF_tend n).comp hσseq_tend_nhdsWithin have hTseq : Tendsto (fun k : ℕ => T (σseq k)) atTop (𝓝 (T 1)) := by have hsum1 : Summable (fun n : ℕ => F (1 : ℝ) n) := by obtain ⟨C, hC⟩ := hT_bdd refine summable_of_sum_range_le (hF_nonneg 1) fun m ↦ le_of_tendsto (tendsto_finsetSum _ fun i _ ↦ hF_tend i) (eventually_of_mem self_mem_nhdsWithin fun σ hσ ↦ ((hSumm σ hσ).sum_le_tsum _ (fun n _ ↦ hF_nonneg σ n)).trans (hC ⟨σ, hσ, rfl⟩)) have hg_ne_top : (∑' n : ℕ, ENNReal.ofReal (F 1 n)) ≠ ⊤ := hsum1.tsum_ofReal_ne_top have hENN : Tendsto (fun k => ∑' n, ENNReal.ofReal (F (σseq k) n)) atTop (𝓝 (∑' n, ENNReal.ofReal (F 1 n))) := tendsto_tsum_of_monotone_convergence (fun n _ _ hk ↦ ENNReal.ofReal_le_ofReal (hmono_seq n hk)) (fun n ↦ ENNReal.tendsto_ofReal (htend_seq n)) have hrew (σ) : (∑' n, ENNReal.ofReal (F σ n)).toReal = ∑' n, F σ n := by rw [ENNReal.tsum_toReal_eq (fun n ↦ by simp)] exact tsum_congr fun n ↦ by simp [hF_nonneg σ n] simp only [T, ← hrew]; exact (ENNReal.tendsto_toReal hg_ne_top).comp hENN have hsSup_eq : sSup (T '' Set.Ioi (1 : ℝ)) = T 1 := tendsto_nhds_unique (hT_tend_sup.comp hσseq_tend_nhdsWithin) hTseq simpa [T, hsSup_eq] using hT_tend_sup lemma limiting_fourier_variant_lim1_aux : letI := @CS.coeFunDict letI := @realFunctionCoeDict ∀ {f : ℕ → ℝ} {x : ℝ} (ψ : CS 2 ℂ) (hpos : 0 ≤ f) (hf : ∀ (σ : ℝ), 1 < σ → Summable (nterm f σ)) (hψpos : ∀ y, 0 ≤ (𝓕 (ψ : ℝ → ℂ) y).re ∧ (𝓕 (ψ : ℝ → ℂ) y).im = 0), ∀ (σ : ℝ), 1 < σ → Summable (fun n : ℕ => (if n = 0 then 0 else f n / ((n : ℝ) ^ σ)) * (𝓕 ψ.toFun (1 / (2 * π) * Real.log ((n : ℝ) / x))).re) := by letI := @CS.coeFunDict letI := @realFunctionCoeDict letI := @W1.coeFunDict letI := @W21.csDict intro f x ψ hpos hf hψpos intro σ hσ let y : ℕ → ℝ := fun n => (1 / (2 * π)) * Real.log ((n : ℝ) / x) let W : ℕ → ℝ := fun n => (𝓕 ψ.toFun (y n)).re let base : ℕ → ℝ := fun n => if n = 0 then 0 else f n / ((n : ℝ) ^ σ) obtain ⟨C, hC⟩ := decay_bounds_cor (W21.ofCS2 ψ) have hC_nonneg : 0 ≤ C := (norm_nonneg _).trans ((hC 0).trans (by simp)) have hW_nonneg (n : ℕ) : 0 ≤ W n := (hψpos (y n)).1 have hnorm_four (n : ℕ) : ‖𝓕 ψ.toFun (y n)‖ = W n := by have him0 : (𝓕 ψ.toFun (y n)).im = 0 := (hψpos (y n)).2 rw [show 𝓕 ψ.toFun (y n) = W n by exact Complex.ext rfl him0] simp [abs_of_nonneg (hW_nonneg n)] have hW_le_C (n : ℕ) : W n ≤ C := by rw [← hnorm_four]; exact (hC (y n)).trans (div_le_self hC_nonneg (by nlinarith [sq_nonneg (y n)])) have hbase_summ : Summable base := by convert hf σ hσ using 1; ext n by_cases hn : n = 0 <;> simp [nterm, base, hn, Real.norm_eq_abs, abs_of_nonneg (hpos n)] refine (hbase_summ.mul_left C).of_norm_bounded fun n ↦ ?_ by_cases hn : n = 0 · simp [base, hn] · have hnpos : 0 < (n : ℝ) := Nat.cast_pos.mpr (Nat.pos_of_ne_zero hn) have hbase_nonneg : 0 ≤ base n := by simp only [base, hn, if_false] exact div_nonneg (hpos n) (Real.rpow_pos_of_pos hnpos σ).le calc |base n * W n| = base n * W n := abs_of_nonneg (mul_nonneg hbase_nonneg (hW_nonneg n)) _ ≤ base n * C := mul_le_mul_of_nonneg_left (hW_le_C n) hbase_nonneg _ = C * base n := mul_comm _ _ theorem limiting_fourier_variant_lim1 : letI := @CS.coeFunDict letI := @realFunctionCoeDict ∀ {f : ℕ → ℝ} {x : ℝ} {ψ : CS 2 ℂ} (hpos : 0 ≤ f) (hψpos : ∀ y, 0 ≤ (𝓕 (ψ : ℝ → ℂ) y).re ∧ (𝓕 (ψ : ℝ → ℂ) y).im = 0) (S : ℝ → ℂ) (hSdef : ∀ σ' : ℝ, S σ' = ∑' n : ℕ, term (fun n ↦ (f n : ℂ)) (σ' : ℝ) n * 𝓕 ψ.toFun (π⁻¹ * 2⁻¹ * Real.log ((n : ℝ) / x))) (hbounded : BoundedAtFilter (𝓝[>] (1 : ℝ)) (fun σ' : ℝ => ‖S σ'‖)) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')), Tendsto (fun σ' : ℝ => ∑' n : ℕ, term (fun n ↦ (f n : ℂ)) (σ' : ℝ) n * 𝓕 ψ.toFun (π⁻¹ * 2⁻¹ * Real.log ((n : ℝ) / x))) (𝓝[>] (1 : ℝ)) (𝓝 (∑' n : ℕ, (f n : ℂ) / (n : ℂ) * 𝓕 ψ.toFun (π⁻¹ * 2⁻¹ * Real.log ((n : ℝ) / x)))) := by letI := @CS.coeFunDict letI := @realFunctionCoeDict letI := @W1.coeFunDict letI := @W21.csDict intro f x ψ hpos hψpos S hSdef hbounded hf let y : ℕ → ℝ := fun n => (π⁻¹ * 2⁻¹) * Real.log ((n : ℝ) / x) let w : ℕ → ℝ := fun n => (𝓕 ψ.toFun (y n)).re have hw_nonneg : ∀ n, 0 ≤ w n := by intro n exact (hψpos (y n)).1 have hFour_eq_ofReal : ∀ n, 𝓕 ψ.toFun (y n) = Complex.ofReal (w n) := by intro n have h := hψpos (y n) refine Complex.ext ?_ ?_ · simp [w] · simp [w, h.2] let rterm : ℝ → ℕ → ℝ := fun σ n => if h0 : n = 0 then 0 else (f n) / ((n : ℝ) ^ σ) * (w n) have summand_eq_ofReal : ∀ (σ : ℝ) (n : ℕ), term (fun n ↦ (f n : ℂ)) (σ : ℝ) n * 𝓕 ψ.toFun (y n) = Complex.ofReal (rterm σ n) := by intro σ n by_cases hn : n = 0 · subst hn simp [rterm, y] · have hnpos : (0 : ℝ) < (n : ℝ) := by exact_mod_cast (Nat.pos_of_ne_zero hn) have hn0 : 0 ≤ (n : ℝ) := le_of_lt hnpos have hcpow : ( (n : ℂ) ^ ((σ : ℝ) : ℂ) ) = ( ( (n : ℝ) ^ σ : ℝ) : ℂ ) := by simpa using (Complex.ofReal_cpow hn0 σ).symm have hpow_ne : ((n : ℝ) ^ σ) ≠ 0 := by exact (ne_of_gt (Real.rpow_pos_of_pos hnpos σ)) calc term (fun n ↦ (f n : ℂ)) (σ : ℝ) n * 𝓕 ψ.toFun (y n) = ((f n : ℂ) / ((n : ℂ) ^ ((σ : ℝ) : ℂ))) * ( (w n : ℝ) : ℂ ) := by simp [term, LSeries.term, hn, hFour_eq_ofReal] _ = ((f n : ℂ) / (((n : ℝ) ^ σ : ℝ) : ℂ)) * ((w n : ℝ) : ℂ) := by simp [hcpow] _ = (( (f n : ℝ) : ℂ) / (((n : ℝ) ^ σ : ℝ) : ℂ)) * ((w n : ℝ) : ℂ) := by simp _ = ( ( (f n : ℝ) / ((n : ℝ) ^ σ) : ℝ) : ℂ ) * ((w n : ℝ) : ℂ) := by simp [Complex.ofReal_div] _ = ( ( (f n : ℝ) / ((n : ℝ) ^ σ) * (w n) : ℝ ) : ℂ ) := by simp [Complex.ofReal_mul] _ = Complex.ofReal (rterm σ n) := by simp [rterm, hn] let T : ℝ → ℝ := fun σ => ∑' n, rterm σ n have tsum_eq_ofReal_T : ∀ σ : ℝ, (∑' n : ℕ, term (fun n ↦ (f n : ℂ)) (σ : ℝ) n * 𝓕 ψ.toFun (y n)) = Complex.ofReal (T σ) := by intro σ have hcongr : (∑' n : ℕ, term (fun n ↦ (f n : ℂ)) (σ : ℝ) n * 𝓕 ψ.toFun (y n)) = ∑' n : ℕ, (Complex.ofReal (rterm σ n)) := by refine tsum_congr ?_ intro n simpa using (summand_eq_ofReal σ n) calc (∑' n : ℕ, term (fun n ↦ (f n : ℂ)) (σ : ℝ) n * 𝓕 ψ.toFun (y n)) = ∑' n : ℕ, (Complex.ofReal (rterm σ n)) := hcongr _ = Complex.ofReal (∑' n : ℕ, rterm σ n) := by simpa using (Complex.ofReal_tsum (fun n : ℕ => rterm σ n)).symm _ = Complex.ofReal (T σ) := by rfl have hS_ofReal_T : ∀ σ : ℝ, S σ = Complex.ofReal (T σ) := by intro σ simpa [hSdef σ, y] using (tsum_eq_ofReal_T σ) have rterm_nonneg : ∀ σ n, 0 ≤ rterm σ n := by intro σ n by_cases hn : n = 0 · subst hn; simp [rterm] · have hf : 0 ≤ f n := hpos n have hw : 0 ≤ w n := hw_nonneg n have hnpos : 0 < (n : ℝ) := by exact_mod_cast (Nat.pos_of_ne_zero hn) have hden : 0 < (n : ℝ) ^ σ := Real.rpow_pos_of_pos hnpos σ have : 0 ≤ (f n) / ((n : ℝ) ^ σ) := div_nonneg hf (le_of_lt hden) simp [rterm, hn, mul_nonneg this hw] have T_nonneg : ∀ σ, 0 ≤ T σ := by intro σ exact tsum_nonneg (fun n => rterm_nonneg σ n) have hT_eq_normS : ∀ σ, T σ = ‖S σ‖ := by intro σ have := hS_ofReal_T σ calc T σ = ‖Complex.ofReal (T σ)‖ := by simp [abs_of_nonneg (T_nonneg σ)] _ = ‖S σ‖ := by simp [this] have hboundedT : BoundedAtFilter (𝓝[>] (1 : ℝ)) (fun σ : ℝ => T σ) := by have : (fun σ : ℝ => T σ) = (fun σ : ℝ => ‖S σ‖) := by funext σ; exact hT_eq_normS σ simpa [this] using hbounded have rterm_antitone : ∀ n, AntitoneOn (fun σ => rterm σ n) (Set.Ioi 1) := by intro n σ₁ hσ₁ σ₂ hσ₂ hσ₁₂ by_cases hn : n = 0 · subst hn; simp [rterm] · have hf : 0 ≤ f n := hpos n have hw : 0 ≤ w n := hw_nonneg n have hnpos : 0 < (n : ℝ) := by exact_mod_cast (Nat.pos_of_ne_zero hn) have hn1 : (1 : ℝ) ≤ (n : ℝ) := by exact_mod_cast (Nat.one_le_iff_ne_zero.mpr hn) have hpow : (n : ℝ) ^ σ₁ ≤ (n : ℝ) ^ σ₂ := Real.rpow_le_rpow_of_exponent_le hn1 hσ₁₂ have hinv : (1 / ((n : ℝ) ^ σ₂)) ≤ (1 / ((n : ℝ) ^ σ₁)) := by have hpos1 : 0 < (n : ℝ) ^ σ₁ := Real.rpow_pos_of_pos hnpos σ₁ exact one_div_le_one_div_of_le hpos1 hpow have hinv_inv : ((n : ℝ) ^ σ₂)⁻¹ ≤ ((n : ℝ) ^ σ₁)⁻¹ := by simpa [one_div] using hinv have hmul1 : (f n) * (((n : ℝ) ^ σ₂)⁻¹) ≤ (f n) * (((n : ℝ) ^ σ₁)⁻¹) := mul_le_mul_of_nonneg_left hinv_inv hf have hmul2 : ((f n) * (((n : ℝ) ^ σ₂)⁻¹)) * (w n) ≤ ((f n) * (((n : ℝ) ^ σ₁)⁻¹)) * (w n) := mul_le_mul_of_nonneg_right hmul1 hw simpa [rterm, hn, div_eq_mul_inv, mul_assoc] using hmul2 have rterm_tend : ∀ n, Tendsto (fun σ : ℝ => rterm σ n) (𝓝[>] (1 : ℝ)) (𝓝 (rterm 1 n)) := by intro n have hterm : Tendsto (fun σ : ℝ => term (fun n ↦ (f n : ℂ)) (σ : ℝ) n) (𝓝[>] (1 : ℝ)) (𝓝 ((f n : ℂ) / (n : ℂ))) := by by_cases hn : n = 0 · subst hn simp [term, LSeries.term] · have hden : Tendsto (fun σ : ℝ => ((n : ℂ) ^ ((σ : ℝ) : ℂ))) (𝓝[>] (1 : ℝ)) (𝓝 ((n : ℂ) ^ (1 : ℂ))) := by simpa using ((continuous_ofReal.tendsto (1 : ℝ)).mono_left nhdsWithin_le_nhds).const_cpow have hden' : Tendsto (fun σ : ℝ => ((n : ℂ) ^ ((σ : ℝ) : ℂ))) (𝓝[>] (1 : ℝ)) (𝓝 (n : ℂ)) := by simpa using hden have hnC : (n : ℂ) ≠ 0 := by exact_mod_cast hn have hterm : Tendsto (fun σ : ℝ => term (fun n ↦ (f n : ℂ)) (σ : ℝ) n) (𝓝[>] (1 : ℝ)) (𝓝 ((f n : ℂ) / (n : ℂ))) := by have hnC : (n : ℂ) ≠ 0 := by exact_mod_cast hn simpa [term, LSeries.term, hn] using! (tendsto_const_nhds.div hden' hnC) exact hterm have hsummand : Tendsto (fun σ : ℝ => term (fun n ↦ (f n : ℂ)) (σ : ℝ) n * 𝓕 ψ.toFun (y n)) (𝓝[>] (1 : ℝ)) (𝓝 (((f n : ℂ) / (n : ℂ)) * 𝓕 ψ.toFun (y n))) := by simpa [mul_assoc, mul_left_comm, mul_comm] using (hterm.mul_const (𝓕 ψ.toFun (y n))) have hre : ∀ σ, rterm σ n = (term (fun n ↦ (f n : ℂ)) (σ : ℝ) n * 𝓕 ψ.toFun (y n)).re := by intro σ have := congrArg Complex.re (summand_eq_ofReal σ n) simpa [Complex.ofReal_re] using this.symm have hRe : Tendsto (fun σ : ℝ => (term (fun n ↦ (f n : ℂ)) (σ : ℝ) n * 𝓕 ψ.toFun (y n)).re) (𝓝[>] (1 : ℝ)) (𝓝 ((((f n : ℂ) / (n : ℂ)) * 𝓕 ψ.toFun (y n)).re)) := (continuous_re.tendsto _).comp hsummand have hlimit_re : (f n / (n : ℝ)) * (𝓕 ψ.toFun (y n)).re = rterm 1 n := by have h0 : (term (fun n ↦ (f n : ℂ)) (1 : ℝ) n * 𝓕 ψ.toFun (y n)).re = rterm 1 n := by have := congrArg Complex.re (summand_eq_ofReal (σ := (1 : ℝ)) n) simpa [Complex.ofReal_re] using this by_cases hn : n = 0 · subst hn simp [rterm, y] · have h1 : (term (fun n ↦ (f n : ℂ)) (1 : ℝ) n * 𝓕 ψ.toFun (y n)).re = (f n / (n : ℝ)) * (𝓕 ψ.toFun (y n)).re := by simp [Complex.mul_re, term, LSeries.term, hn, y, (hψpos (y n)).2] exact (h1.symm.trans h0) simpa [hre, hlimit_re] using hRe have hSumm_rterm : ∀ σ : ℝ, 1 < σ → Summable (fun n : ℕ => rterm σ n) := by simpa [rterm] using limiting_fourier_variant_lim1_aux (ψ := ψ) (f := f) (x := x) hpos hf hψpos have hT_tend : Tendsto T (𝓝[>] (1 : ℝ)) (𝓝 (T 1)) := by have : Tendsto (fun σ : ℝ => ∑' n : ℕ, rterm σ n) (𝓝[>] (1 : ℝ)) (𝓝 (∑' n : ℕ, rterm (1 : ℝ) n)) := by refine tendsto_tsum_of_monotone_convergence_nhdsGT_one (F := rterm) (hF_nonneg := rterm_nonneg) (hF_antitone := rterm_antitone) (hF_tend := rterm_tend) (hSumm := hSumm_rterm) (hbounded := hboundedT) simpa [T] using this have hToReal : Tendsto (fun σ => Complex.ofReal (T σ)) (𝓝[>] (1 : ℝ)) (𝓝 (Complex.ofReal (T 1))) := (continuous_ofReal.tendsto _).comp hT_tend have hsource : (fun σ : ℝ => ∑' n : ℕ, term (fun n ↦ (f n : ℂ)) (σ : ℝ) n * 𝓕 ψ.toFun (y n)) = fun σ : ℝ => Complex.ofReal (T σ) := by funext σ exact (tsum_eq_ofReal_T σ) have hσ1 : (∑' n : ℕ, term (fun n ↦ (f n : ℂ)) (↑(1:ℝ)) n * 𝓕 ψ.toFun (y n)) = (↑(T 1) : ℂ) := by simpa using (tsum_eq_ofReal_T (σ := (1:ℝ))) have hterm1 : ∀ n : ℕ, term (fun n ↦ (f n : ℂ)) (1 : ℂ) n = (f n : ℂ) / (n : ℂ) := by intro n by_cases hn : n = 0 · subst hn simp [term, LSeries.term] · simp [term, LSeries.term, hn] have hrewrite : (∑' n : ℕ, term (fun n ↦ (f n : ℂ)) (1 : ℂ) n * 𝓕 ψ.toFun (y n)) = (∑' n : ℕ, (f n : ℂ) / (n : ℂ) * 𝓕 ψ.toFun (y n)) := by refine tsum_congr ?_ intro n simp [hterm1 n] have htarget : (∑' n : ℕ, (f n : ℂ) / (n : ℂ) * 𝓕 ψ.toFun (y n)) = (↑(T 1) : ℂ) := by exact (hrewrite.symm.trans hσ1) simpa [hsource, htarget, y] using hToReal lemma limiting_fourier_variant : letI := @CS.coeFunDict letI := @realFunctionCoeDict ∀ (hpos : 0 ≤ f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (ψ : CS 2 ℂ) (hψpos : ∀ y, 0 ≤ (𝓕 (ψ : ℝ → ℂ) y).re ∧ (𝓕 (ψ : ℝ → ℂ) y).im = 0) (hx : 0 < x), ∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * log (n / x)) - A * ∫ u in Set.Ici (-log x), 𝓕 (ψ : ℝ → ℂ) (u / (2 * π)) = ∫ (t : ℝ), (G (1 + t * I)) * (ψ t) * x ^ (t * I) := by letI := @CS.coeFunDict letI := @realFunctionCoeDict letI := @W1.coeFunDict letI := @W21.csDict intro hpos hG hG' hf ψ hψpos hx have l2 := limiting_fourier_lim2_gt_zero (A := A) (x := x) ψ hx have l3 := limiting_fourier_lim3_gt_zero (G := G) (x := x) hG ψ hx let S : ℝ → ℂ := fun σ' => ∑' n : ℕ, term (fun n ↦ (f n : ℂ)) σ' n * 𝓕 ψ.toFun (1 / (2 * π) * Real.log ((n : ℝ) / x)) let Pole : ℝ → ℂ := fun σ' => (A : ℂ) * ((x ^ (1 - σ') : ℝ) : ℂ) * ∫ u in Set.Ici (-Real.log x), (rexp (-u * (σ' - 1)) : ℂ) * 𝓕 (W21.ofCS2 ψ).toFun (u / (2 * π)) let RHS : ℝ → ℂ := fun σ' => ∫ t : ℝ, G (σ' + t * I) * ψ.toFun t * (x : ℂ) ^ (t * I) have haux : (fun σ' ↦ ∑' (n : ℕ), term (fun n ↦ (f n : ℂ)) (σ' : ℂ) n * 𝓕 ψ.toFun (π⁻¹ * 2⁻¹ * Real.log ((n : ℝ) / x)) - (A : ℂ) * ((x ^ (1 - σ') : ℝ) : ℂ) * ∫ (u : ℝ) in Ici (-Real.log x), cexp (-( (u : ℂ) * ((σ' : ℂ) - 1))) * 𝓕 (W21.ofCS2 ψ).toFun (u / (2 * π))) =ᶠ[𝓝[>] (1 : ℝ)] (fun σ' ↦ ∫ (t : ℝ), G ((σ' : ℂ) + (t : ℂ) * I) * ψ.toFun t * (x : ℂ) ^ ((t : ℂ) * I)) := by rw [Filter.EventuallyEq] refine eventually_nhdsWithin_of_forall ?_ intro σ' hσ' have hσ' : (1 : ℝ) < σ' := by simpa [Set.mem_Ioi] using hσ' simpa using! (limiting_fourier_aux_gt_zero (G := G) (f := f) (A := A) hG' hf ψ hx σ' hσ') have haux' : (fun σ' : ℝ => S σ') =ᶠ[𝓝[>] (1 : ℝ)] (fun σ' : ℝ => RHS σ' + Pole σ') := by rw [Filter.EventuallyEq] at haux ⊢ filter_upwards [haux] with σ' hσ' have hσ'' : S σ' - Pole σ' = RHS σ' := by simpa [S, Pole, RHS] using hσ' have hadd : (S σ' - Pole σ') + Pole σ' = RHS σ' + Pole σ' := congrArg (fun z : ℂ => z + Pole σ') hσ'' simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using hadd let Pole₁ : ℂ := (A : ℂ) * ∫ u in Set.Ici (-Real.log x), 𝓕 (W21.ofCS2 ψ).toFun (u / (2 * π)) let RHS₁ : ℂ := ∫ t : ℝ, G (1 + (t : ℂ) * I) * ψ.toFun t * (x : ℂ) ^ ((t : ℂ) * I) have hRHS_le : ∀ᶠ σ' : ℝ in 𝓝[>] (1 : ℝ), ‖RHS σ'‖ ≤ ‖RHS₁‖ + 1 := by have hball : Metric.ball RHS₁ (1 : ℝ) ∈ 𝓝 RHS₁ := by simpa using (Metric.ball_mem_nhds (x := RHS₁) (ε := (1 : ℝ)) (by norm_num)) have hpre : {σ' : ℝ | RHS σ' ∈ Metric.ball RHS₁ (1 : ℝ)} ∈ (𝓝[>] (1 : ℝ)) := l3 hball filter_upwards [hpre] with σ' hmem have hdist' : dist (RHS σ') RHS₁ < (1 : ℝ) := by simpa [Metric.mem_ball] using hmem have hdist : ‖RHS σ' - RHS₁‖ < (1 : ℝ) := by simpa [dist_eq_norm] using hdist' have htri : ‖RHS σ'‖ ≤ ‖RHS₁‖ + ‖RHS σ' - RHS₁‖ := by have h := norm_add_le (RHS σ' - RHS₁) RHS₁ simpa [sub_add_cancel, add_comm, add_left_comm, add_assoc] using h have hle : ‖RHS₁‖ + ‖RHS σ' - RHS₁‖ ≤ ‖RHS₁‖ + (1 : ℝ) := by exact add_le_add_right (le_of_lt hdist) ‖RHS₁‖ exact htri.trans hle have hPole_le : ∀ᶠ σ' : ℝ in 𝓝[>] (1 : ℝ), ‖Pole σ'‖ ≤ ‖Pole₁‖ + 1 := by have hball : Metric.ball Pole₁ 1 ∈ 𝓝 Pole₁ := by simpa using (Metric.ball_mem_nhds Pole₁ (by norm_num : (0 : ℝ) < 1)) have hpre : {σ' : ℝ | Pole σ' ∈ Metric.ball Pole₁ 1} ∈ (𝓝[>] (1 : ℝ)) := l2 hball filter_upwards [hpre] with σ' hmem have hdist : ‖Pole σ' - Pole₁‖ < 1 := by simpa [Metric.mem_ball, dist_eq_norm] using hmem have htri : ‖Pole σ'‖ ≤ ‖Pole₁‖ + ‖Pole σ' - Pole₁‖ := by have hdecomp : Pole σ' = Pole₁ + (Pole σ' - Pole₁) := by abel have hnorm_eq : ‖Pole σ'‖ = ‖Pole₁ + (Pole σ' - Pole₁)‖ := by simp [congrArg (fun z : ℂ => ‖z‖) hdecomp] calc ‖Pole σ'‖ = ‖Pole₁ + (Pole σ' - Pole₁)‖ := hnorm_eq _ ≤ ‖Pole₁‖ + ‖Pole σ' - Pole₁‖ := norm_add_le _ _ have hdist_le : ‖Pole σ' - Pole₁‖ ≤ 1 := le_of_lt hdist have hsum : ‖Pole₁‖ + ‖Pole σ' - Pole₁‖ ≤ ‖Pole₁‖ + 1 := by simpa [add_comm, add_left_comm, add_assoc] using (add_le_add_left hdist_le ‖Pole₁‖) exact htri.trans hsum have hS_le : ∀ᶠ σ' : ℝ in 𝓝[>] (1 : ℝ), ‖S σ'‖ ≤ (‖RHS₁‖ + 1) + (‖Pole₁‖ + 1) := by rw [Filter.EventuallyEq] at haux' filter_upwards [haux', hRHS_le, hPole_le] with σ' hEq hR hP calc ‖S σ'‖ = ‖RHS σ' + Pole σ'‖ := by simp [hEq] _ ≤ ‖RHS σ'‖ + ‖Pole σ'‖ := norm_add_le _ _ _ ≤ (‖RHS₁‖ + 1) + (‖Pole₁‖ + 1) := by exact add_le_add hR hP have hbounded : BoundedAtFilter (𝓝[>] (1 : ℝ)) (fun σ' : ℝ => ‖S σ'‖) := by let C : ℝ := ‖RHS₁‖ + 1 + (‖Pole₁‖ + 1) simp only [BoundedAtFilter, Asymptotics.IsBigO, Asymptotics.IsBigOWith] refine ⟨C, ?_⟩ filter_upwards [hS_le] with σ' hσ' simpa [Real.norm_eq_abs, abs_of_nonneg (norm_nonneg (S σ'))] using hσ' have hcoef : (1 / (2 * π) : ℝ) = (π⁻¹ * 2⁻¹ : ℝ) := by field_simp [pi_ne_zero] have l1 := limiting_fourier_variant_lim1 (f := f) (x := x) (ψ := ψ) hpos hψpos (S := S) (hSdef := by intro σ simp [S, hcoef] ) hbounded hf have l1S : Tendsto S (𝓝[>] (1 : ℝ)) (𝓝 (∑' n : ℕ, (f n : ℂ) / (n : ℂ) * 𝓕 ψ.toFun (1 / (2 * π) * Real.log (↑n / x)))) := by simpa [S, hcoef] using l1 have l12 : Tendsto (fun σ' : ℝ => S σ' - Pole σ') (𝓝[>] (1 : ℝ)) (𝓝 ((∑' n : ℕ, (f n : ℂ) / (n : ℂ) * 𝓕 ψ.toFun (1 / (2 * π) * Real.log (↑n / x))) - Pole₁)) := l1S.sub l2 have hPole : (Pole : ℝ → ℂ) =ᶠ[𝓝[>] (1 : ℝ)] Pole := by simp have haux_sub : (fun σ' : ℝ => S σ' - Pole σ') =ᶠ[𝓝[>] (1 : ℝ)] RHS := by filter_upwards [haux'] with σ' hσ' calc S σ' - Pole σ' = (RHS σ' + Pole σ') - Pole σ' := by simp [hσ'] _ = RHS σ' := by simp have hlim := tendsto_nhds_unique_of_eventuallyEq (l1S.sub l2) l3 haux_sub simpa [Pole₁, RHS₁] using! hlim lemma norm_mul_integral_Ici_le_integral_norm (A : ℂ) (F : ℝ → ℂ) (a : ℝ) (hF : IntegrableOn F (Set.Ici a)) (hnorm : Integrable (fun u : ℝ => ‖F u‖)) : ‖A * (∫ u in Set.Ici a, F u)‖ ≤ ‖A‖ * (∫ u : ℝ, ‖F u‖) := by have hmul : ‖A * (∫ u in Set.Ici a, F u)‖ = ‖A‖ * ‖∫ u in Set.Ici a, F u‖ := by simp have hnormI : ‖∫ u in Set.Ici a, F u‖ ≤ ∫ u in Set.Ici a, ‖F u‖ := by have _ : Integrable F (Measure.restrict volume (Set.Ici a)) := hF have h : ‖∫ u, F u ∂Measure.restrict volume (Set.Ici a)‖ ≤ ∫ u, ‖F u‖ ∂Measure.restrict volume (Set.Ici a) := norm_integral_le_integral_norm (μ := Measure.restrict volume (Set.Ici a)) (f := F) simpa using h have hdom : (∫ u in Set.Ici a, ‖F u‖) ≤ ∫ u : ℝ, ‖F u‖ := by have hEq : (∫ u in Set.Ici a, ‖F u‖) = ∫ u : ℝ, Set.indicator (Set.Ici a) (fun u => ‖F u‖) u := by have h := (integral_indicator (μ := (volume : Measure ℝ)) (s := Set.Ici a) (f := fun u => ‖F u‖)) have h' := h measurableSet_Ici simpa using h'.symm have hind_int : Integrable (Set.indicator (Set.Ici a) (fun u => ‖F u‖)) := hnorm.indicator measurableSet_Ici have hpoint : Set.indicator (Set.Ici a) (fun u => ‖F u‖) ≤ᵐ[volume] (fun u : ℝ => ‖F u‖) := by filter_upwards with u by_cases hu : u ∈ Set.Ici a · simp [Set.indicator_of_mem hu] · simp [Set.indicator_of_notMem hu] have hmono := integral_mono_ae (μ := (volume : Measure ℝ)) hind_int hnorm hpoint simpa [hEq] using hmono calc ‖A * (∫ u in Set.Ici a, F u)‖ = ‖A‖ * ‖∫ u in Set.Ici a, F u‖ := hmul _ ≤ ‖A‖ * (∫ u in Set.Ici a, ‖F u‖) := mul_le_mul_of_nonneg_left hnormI (by simp) _ ≤ ‖A‖ * (∫ u : ℝ, ‖F u‖) := mul_le_mul_of_nonneg_left hdom (by simp) lemma fourier_decay_of_CS2 : letI := @CS.coeFunDict ∀ (ψ : CS 2 ℂ), ∃ C : ℝ, ∀ u : ℝ, ‖𝓕 (ψ : ℝ → ℂ) u‖ ≤ C / (1 + u ^ 2) := by letI := @CS.coeFunDict letI := @W1.coeFunDict letI := @W21.csDict intro ψ let ψ' : W21 := (ψ : W21) obtain ⟨C, hC⟩ : ∃ C : ℝ, ∀ u : ℝ, ‖𝓕 (ψ' : ℝ → ℂ) u‖ ≤ C / (1 + u ^ 2) := by simpa using (decay_bounds_cor (ψ := ψ')) refine ⟨C, ?_⟩ intro u simpa [ψ'] using! (hC u) lemma integrable_norm_fourier_scaled_of_CS2 : letI := @CS.coeFunDict ∀ (ψ : CS 2 ℂ), Integrable (fun u : ℝ => ‖𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))‖) := by letI := @CS.coeFunDict letI := @W1.coeFunDict letI := @W21.csDict intro ψ obtain ⟨C, hdecay⟩ := fourier_decay_of_CS2 (ψ := ψ) have hC_nonneg : 0 ≤ C := by have h0 := hdecay 0 have hnorm : 0 ≤ ‖𝓕 (ψ : ℝ → ℂ) 0‖ := norm_nonneg _ have hC' : ‖𝓕 (ψ : ℝ → ℂ) 0‖ ≤ C := by simpa using h0 exact hnorm.trans hC' have hmaj_int : Integrable (fun u : ℝ => (C : ℝ) / (1 + (u / (2 * Real.pi))^2)) := by have hbase : Integrable (fun u : ℝ => (1 + u ^ 2)⁻¹) := integrable_inv_one_add_sq have hscale : Integrable (fun u : ℝ => (1 + (u / (2 * Real.pi)) ^ 2)⁻¹) := hbase.comp_div (by nlinarith [Real.pi_pos]) simpa [div_eq_mul_inv, mul_comm, mul_left_comm, mul_assoc, pow_two] using hscale.const_mul C have hle : (fun u : ℝ => ‖𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))‖) ≤ᵐ[volume] (fun u : ℝ => (C : ℝ) / (1 + (u / (2 * Real.pi))^2)) := by refine Filter.Eventually.of_forall ?_ intro u simpa using (hdecay (u / (2 * Real.pi))) have hle_norm : (fun u : ℝ => ‖‖𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))‖‖) ≤ᵐ[volume] (fun u : ℝ => ‖(C : ℝ) / (1 + (u / (2 * Real.pi))^2)‖) := by refine hle.mono ?_ intro u hu have hden_pos : 0 < 1 + (u / (2 * Real.pi)) ^ 2 := by nlinarith have hnonneg : 0 ≤ (C : ℝ) / (1 + (u / (2 * Real.pi))^2) := div_nonneg hC_nonneg hden_pos.le have hleft_nonneg : 0 ≤ ‖𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))‖ := norm_nonneg _ have hbound : ‖‖𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))‖‖ ≤ (C : ℝ) / (1 + (u / (2 * Real.pi))^2) := by simpa [Real.norm_eq_abs, abs_of_nonneg hleft_nonneg] using hu have hC_abs : |C| = C := abs_of_nonneg hC_nonneg have hden_abs : |1 + (u / (2 * Real.pi))^2| = 1 + (u / (2 * Real.pi))^2 := by have : 0 ≤ 1 + (u / (2 * Real.pi))^2 := by nlinarith simpa using abs_of_nonneg this have hnorm : ‖(C : ℝ) / (1 + (u / (2 * Real.pi))^2)‖ = (C : ℝ) / (1 + (u / (2 * Real.pi))^2) := by have hrec : ‖(C : ℝ) / (1 + (u / (2 * Real.pi))^2)‖ = |C| / |1 + (u / (2 * Real.pi))^2| := by simp [Real.norm_eq_abs] simp [hC_abs, hden_abs, hrec] simpa [hnorm] using hbound have hmaj_int_norm : Integrable (fun u : ℝ => ‖(C : ℝ) / (1 + (u / (2 * Real.pi))^2)‖) := hmaj_int.norm have hmeas : AEStronglyMeasurable (fun u : ℝ => ‖𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))‖) := by have hcont : Continuous fun u : ℝ => 𝓕 (ψ : ℝ → ℂ) u := by simpa using! continuous_FourierIntegral (ψ : W21) have hcont_scaled : Continuous fun u : ℝ => 𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi)) := hcont.comp (by continuity) exact hcont_scaled.aestronglyMeasurable.norm exact hmaj_int_norm.mono' hmeas hle_norm lemma exists_bound_norm_G_on_tsupport : letI := @CS.coeFunDict ∀ (hG : ContinuousOn G {s : ℂ | 1 ≤ s.re}) (ψ : CS 2 ℂ), ∃ K : ℝ, ∀ t : ℝ, t ∈ tsupport (ψ : ℝ → ℂ) → ‖G (1 + t * Complex.I)‖ ≤ K := by letI := @CS.coeFunDict letI := @W1.coeFunDict letI := @W21.csDict intro hG ψ let s : Set ℝ := tsupport (ψ : ℝ → ℂ) have hscompact : IsCompact s := by simpa [s] using (ψ.h2.isCompact : IsCompact (tsupport (ψ : ℝ → ℂ))) have hphi_cont : Continuous (fun t : ℝ => (1 : ℂ) + t * Complex.I) := by continuity have hphi_maps : Set.MapsTo (fun t : ℝ => (1 : ℂ) + t * Complex.I) s {z : ℂ | 1 ≤ z.re} := by intro t ht simp have hGcomp : ContinuousOn (fun t : ℝ => G ((1 : ℂ) + t * Complex.I)) s := hG.comp hphi_cont.continuousOn hphi_maps have hnorm_contOn : ContinuousOn (fun t : ℝ => ‖G ((1 : ℂ) + t * Complex.I)‖) s := hGcomp.norm have hbdd : BddAbove ((fun t : ℝ => ‖G ((1 : ℂ) + t * Complex.I)‖) '' s) := (hscompact.image_of_continuousOn hnorm_contOn).bddAbove refine ⟨sSup ((fun t : ℝ => ‖G ((1 : ℂ) + t * Complex.I)‖) '' s), ?_⟩ intro t ht have : ‖G ((1 : ℂ) + t * Complex.I)‖ ∈ (fun t : ℝ => ‖G ((1 : ℂ) + t * Complex.I)‖) '' s := ⟨t, ht, rfl⟩ exact le_csSup hbdd this lemma norm_integrand_le_K_mul_norm_psi {x K : ℝ} (hx : 0 < x) (hK : ∀ t : ℝ, t ∈ Function.support ψ → ‖G (1 + t * Complex.I)‖ ≤ K) : ∀ t : ℝ, ‖(G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))‖ ≤ K * ‖ψ t‖ := by intro t by_cases ht : t ∈ Function.support ψ · have hxnorm : ‖((x : ℂ) ^ (t * Complex.I))‖ = 1 := norm_x_cpow_it x t hx calc ‖(G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))‖ = ‖G (1 + t * Complex.I)‖ * ‖ψ t‖ * ‖((x : ℂ) ^ (t * Complex.I))‖ := by simp [mul_left_comm, mul_comm] _ = ‖G (1 + t * Complex.I)‖ * ‖ψ t‖ * 1 := by simp [hxnorm] _ ≤ K * ‖ψ t‖ := by have hGle : ‖G (1 + t * Complex.I)‖ ≤ K := hK t ht have : ‖G (1 + t * Complex.I)‖ * ‖ψ t‖ ≤ K * ‖ψ t‖ := mul_le_mul_of_nonneg_right hGle (norm_nonneg _) simpa [mul_assoc, mul_left_comm, mul_comm] using this · have hψ0 : ψ t = 0 := by by_contra hψ0 exact ht (by simpa [Function.support] using hψ0) simp [hψ0, mul_comm] lemma norm_error_integral_le (ψ : ℝ → ℂ) (x K : ℝ) (hGline_meas : Measurable (fun t : ℝ => G (1 + t * I))) (hψ_meas : AEStronglyMeasurable ψ) (hx : 0 < x) (hK : ∀ t : ℝ, t ∈ Function.support ψ → ‖G (1 + t * Complex.I)‖ ≤ K) (hψ : Integrable (fun t : ℝ => ‖ψ t‖) ) : ‖∫ t : ℝ, (G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))‖ ≤ K * (∫ t : ℝ, ‖ψ t‖) := by have h1 : ‖∫ t : ℝ, (G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))‖ ≤ ∫ t : ℝ, ‖(G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))‖ := by simpa using (norm_integral_le_integral_norm (f := fun t : ℝ => (G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I)))) have hmeas_main : AEStronglyMeasurable (fun t : ℝ => (G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))) := by have hG' : AEMeasurable fun t : ℝ => G (1 + t * Complex.I) := hGline_meas.aemeasurable have hψ_meas' : AEMeasurable ψ := hψ_meas.aemeasurable have hx_ne : (x : ℂ) ≠ 0 := by exact_mod_cast (ne_of_gt hx) letI hx_ne' : NeZero (x : ℂ) := ⟨hx_ne⟩ have hxpow_meas : AEMeasurable fun t : ℝ => ((x : ℂ) ^ (t * Complex.I)) := by have hcontℂ : Continuous fun z : ℂ => ((x : ℂ) ^ z) := continuous_const_cpow (z := (x : ℂ)) have hcont : Continuous fun t : ℝ => ((x : ℂ) ^ ((t : ℂ) * Complex.I)) := hcontℂ.comp (by have h : Continuous fun t : ℝ => (t : ℂ) * Complex.I := by simpa using! (continuous_ofReal.mul continuous_const) simpa [mul_comm] using h) exact hcont.measurable.aemeasurable have hGψ_meas : AEMeasurable fun t : ℝ => (G (1 + t * Complex.I)) * (ψ t) := hG'.mul hψ_meas' have htotal : AEMeasurable (fun t : ℝ => (G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))) := hGψ_meas.mul hxpow_meas exact htotal.aestronglyMeasurable have hpt : (fun t : ℝ => ‖(G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))‖) ≤ᵐ[volume] (fun t : ℝ => K * ‖ψ t‖) := by refine Eventually.of_forall ?_ intro t exact norm_integrand_le_K_mul_norm_psi (hx := hx) (hK := hK) t have hR : Integrable (fun t : ℝ => K * ‖ψ t‖) := hψ.const_mul K have hL : Integrable (fun t : ℝ => ‖(G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))‖) := by have hpt_norm : (fun t : ℝ => ‖‖(G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))‖‖) ≤ᵐ[volume] (fun t : ℝ => K * ‖ψ t‖) := hpt.mono (by intro t ht simpa [norm_mul, mul_comm, mul_left_comm, mul_assoc] using ht) exact hR.mono' hmeas_main.norm hpt_norm have h2 : (∫ t : ℝ, ‖(G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))‖) ≤ ∫ t : ℝ, K * ‖ψ t‖ := integral_mono_ae (μ := (volume : Measure ℝ)) hL hR hpt have h3 : (∫ t : ℝ, K * ‖ψ t‖) = K * (∫ t : ℝ, ‖ψ t‖) := by simp [integral_const_mul] calc ‖∫ t : ℝ, (G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))‖ ≤ ∫ t : ℝ, ‖(G (1 + t * Complex.I)) * (ψ t) * ((x : ℂ) ^ (t * Complex.I))‖ := h1 _ ≤ ∫ t : ℝ, K * ‖ψ t‖ := h2 _ = K * (∫ t : ℝ, ‖ψ t‖) := h3 lemma crude_upper_bound : letI := @CS.coeFunDict letI := @realFunctionCoeDict ∀ (hpos : 0 ≤ f) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (ψ : CS 2 ℂ) (hψpos : ∀ y, 0 ≤ (𝓕 (ψ : ℝ → ℂ) y).re ∧ (𝓕 (ψ : ℝ → ℂ) y).im = 0), ∃ B : ℝ, ∀ x : ℝ, 0 < x → ‖∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * π) * log (n / x))‖ ≤ B := by letI := @CS.coeFunDict letI := @realFunctionCoeDict letI := @W1.coeFunDict letI := @W21.csDict intro hpos hG hG' hf ψ hψpos -- Integrability of ψ have hψ_int : MeasureTheory.Integrable (ψ : ℝ → ℂ) := by simpa using (ψ.h1.continuous.integrable_of_hasCompactSupport ψ.h2) have hψ_norm_int : MeasureTheory.Integrable (fun t : ℝ => ‖(ψ : ℝ → ℂ) t‖) := hψ_int.norm have hψ_meas : MeasureTheory.AEStronglyMeasurable (ψ : ℝ → ℂ) := hψ_int.aestronglyMeasurable -- Uniform bound K for ‖G(1+it)‖ on support ψ rcases exists_bound_norm_G_on_tsupport (G := G) hG ψ with ⟨K, hK_ts⟩ have hK_support : ∀ t : ℝ, t ∈ Function.support (ψ : ℝ → ℂ) → ‖G (1 + t * Complex.I)‖ ≤ K := by have hbnG (hKts : ∀ t : ℝ, t ∈ tsupport ψ → ‖G (1 + t * Complex.I)‖ ≤ K) : ∀ t : ℝ, t ∈ Function.support ψ → ‖G (1 + t * Complex.I)‖ ≤ K := by intro t ht exact hKts t ((subset_tsupport ψ) ht) exact hbnG hK_ts -- Measurability of the line restriction t ↦ G(1 + t I) from continuity-on have hGline_meas : Measurable (fun t : ℝ => G (1 + t * Complex.I)) := by have hline_cont : Continuous (fun t : ℝ => (1 : ℂ) + t * Complex.I) := by continuity have hmem : ∀ t : ℝ, ((1 : ℂ) + t * Complex.I) ∈ {s : ℂ | 1 ≤ s.re} := by intro t simp have hcont : Continuous (G ∘ fun t : ℝ => (1 : ℂ) + t * Complex.I) := hG.comp_continuous hline_cont hmem simpa [Function.comp] using! hcont.measurable -- L¹ bound for the scaled Fourier transform norm have hF_norm_int : MeasureTheory.Integrable (fun u : ℝ => ‖𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))‖) := integrable_norm_fourier_scaled_of_CS2 ψ have hF_meas : MeasureTheory.AEStronglyMeasurable (fun u : ℝ => 𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))) := by have hcont : Continuous fun u : ℝ => 𝓕 (ψ : ℝ → ℂ) u := by simpa using! continuous_FourierIntegral (ψ : W21) have hcont_scaled : Continuous fun u : ℝ => 𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi)) := hcont.comp (by continuity) exact hcont_scaled.aestronglyMeasurable have hF_int : MeasureTheory.Integrable (fun u : ℝ => 𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))) := by have hfin_norm : MeasureTheory.HasFiniteIntegral (fun u : ℝ => ‖𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))‖) := hF_norm_int.hasFiniteIntegral have hfin : MeasureTheory.HasFiniteIntegral (fun u : ℝ => 𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))) := by simpa [MeasureTheory.hasFiniteIntegral_iff_norm] using hfin_norm exact ⟨hF_meas, hfin⟩ refine ⟨K * (∫ t : ℝ, ‖(ψ : ℝ → ℂ) t‖) + ‖A‖ * (∫ u : ℝ, ‖𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))‖), ?_⟩ intro x hx set I : ℂ := ∫ u in Set.Ici (-Real.log x), 𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi)) with hI -- Lemma 12 have hlim := limiting_fourier_variant (f := f) (A := A) (G := G) hpos hG hG' hf ψ hψpos hx have hlim' : (∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * Real.pi) * Real.log (n / x))) - A * I = ∫ (t : ℝ), (G (1 + t * Complex.I)) * (ψ t) * x ^ (t * Complex.I) := by simpa [hI] using hlim -- express the tsum as RHS + A*I have htsum : (∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * Real.pi) * Real.log (n / x))) = (∫ (t : ℝ), (G (1 + t * Complex.I)) * (ψ t) * x ^ (t * Complex.I)) + A * I := by have h' : (∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * Real.pi) * Real.log (n / x))) = (∫ (t : ℝ), (G (1 + t * Complex.I)) * (ψ t) * x ^ (t * Complex.I)) + A * I := eq_add_of_sub_eq hlim' simpa [add_comm, mul_comm, mul_left_comm, mul_assoc] using h' -- bound the RHS integral have hRHS_bound : ‖∫ (t : ℝ), (G (1 + t * Complex.I)) * (ψ t) * x ^ (t * Complex.I)‖ ≤ K * (∫ t : ℝ, ‖(ψ : ℝ → ℂ) t‖) := norm_error_integral_le (G := G) (ψ := (ψ : ℝ → ℂ)) (x := x) (K := K) hGline_meas hψ_meas hx hK_support hψ_norm_int -- bound the A * I term have hA_bound : ‖A * I‖ ≤ ‖A‖ * (∫ u : ℝ, ‖𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))‖) := by have hF_on : MeasureTheory.IntegrableOn (fun u : ℝ => 𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))) (Set.Ici (-Real.log x)) := hF_int.integrableOn simpa [hI] using norm_mul_integral_Ici_le_integral_norm (A := A) (F := fun u : ℝ => 𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))) (a := -Real.log x) hF_on hF_norm_int -- combine bounds have htsum_std : (∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * Real.pi) * Real.log ((n : ℝ) / x))) = (∫ (t : ℝ), (G (1 + t * Complex.I)) * (ψ t) * x ^ (t * Complex.I)) + A * I := by simpa [one_div, mul_comm, mul_left_comm, mul_assoc] using htsum -- bound in the normalized form have hbound : ‖∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * Real.pi) * Real.log ((n : ℝ) / x))‖ ≤ K * (∫ t : ℝ, ‖(ψ : ℝ → ℂ) t‖) + ‖A‖ * (∫ u : ℝ, ‖𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))‖) := by have hnorm : ‖∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * Real.pi) * Real.log ((n : ℝ) / x))‖ = ‖(∫ (t : ℝ), (G (1 + t * Complex.I)) * (ψ t) * x ^ (t * Complex.I)) + A * I‖ := congrArg norm htsum_std calc ‖∑' n, f n / n * 𝓕 (ψ : ℝ → ℂ) (1 / (2 * Real.pi) * Real.log ((n : ℝ) / x))‖ = ‖(∫ (t : ℝ), (G (1 + t * Complex.I)) * (ψ t) * x ^ (t * Complex.I)) + A * I‖ := hnorm _ ≤ ‖∫ (t : ℝ), (G (1 + t * Complex.I)) * (ψ t) * x ^ (t * Complex.I)‖ + ‖A * I‖ := norm_add_le _ _ _ ≤ K * (∫ t : ℝ, ‖(ψ : ℝ → ℂ) t‖) + ‖A‖ * (∫ u : ℝ, ‖𝓕 (ψ : ℝ → ℂ) (u / (2 * Real.pi))‖) := add_le_add hRHS_bound hA_bound exact hbound lemma Real.fourierIntegral_convolution {f g : ℝ → ℂ} (hf : Integrable f) (hg : Integrable g) : 𝓕 (convolution f g (ContinuousLinearMap.mul ℂ ℂ) volume) = 𝓕 f * 𝓕 g := by ext y simp only [Pi.mul_apply, Real.fourier_real_eq, MeasureTheory.convolution, ContinuousLinearMap.mul_apply', mul_comm _ y] have h_int : Integrable (fun p : ℝ × ℝ ↦ 𝐞 (-(y * p.1)) • (f p.2 * g (p.1 - p.2))) := by simp only [Circle.smul_def, smul_eq_mul] refine (Integrable.convolution_integrand (ContinuousLinearMap.mul ℂ ℂ) hf hg).bdd_mul (c := 1) ?_ ?_ · exact (by continuity : Continuous _).aestronglyMeasurable · filter_upwards with p change ‖((𝐞 (-(y * p.1)) : Circle) : ℂ)‖ ≤ 1 exact (Circle.norm_coe _).le calc ∫ v, 𝐞 (-(y * v)) • ∫ t, f t * g (v - t) = ∫ v, ∫ t, 𝐞 (-(y * v)) • (f t * g (v - t)) := by simp only [Circle.smul_def, smul_eq_mul, ← integral_const_mul] _ = ∫ t, ∫ v, 𝐞 (-(y * v)) • (f t * g (v - t)) := integral_integral_swap h_int _ = ∫ t, f t • ∫ v, 𝐞 (-(y * v)) • g (v - t) := by simp only [Circle.smul_def, smul_eq_mul, mul_left_comm, integral_const_mul] _ = ∫ t, f t • ∫ u, 𝐞 (-(y * (u + t))) • g u := by congr 1; ext t rw [← integral_add_right_eq_self (fun v ↦ 𝐞 (-(y * v)) • g (v - t)) t]; simp _ = ∫ t, f t • ∫ u, (𝐞 (-(y * t)) * 𝐞 (-(y * u))) • g u := by congr 2 with t; congr 1 simp only [mul_add, neg_add, mul_comm, Real.fourierChar.map_add_eq_mul] _ = ∫ t, 𝐞 (-(y * t)) • f t • ∫ u, 𝐞 (-(y * u)) • g u := by congr 1; ext t simp only [mul_smul, Circle.smul_def, smul_eq_mul, integral_const_mul]; ring _ = (∫ t, 𝐞 (-(y * t)) • f t) * ∫ u, 𝐞 (-(y * u)) • g u := by simp only [Circle.smul_def, smul_eq_mul, ← mul_assoc, integral_mul_const] lemma Real.fourierIntegral_conj_neg {f : ℝ → ℂ} (y : ℝ) : 𝓕 (fun x ↦ conj (f (-x))) y = conj (𝓕 f y) := by simp only [fourier_real_eq] have h_conj : ∀ x, 𝐞 (-(x * y)) • conj (f (-x)) = conj (𝐞 (x * y) • f (-x)) := fun x ↦ by simp only [Circle.smul_def, Real.fourierChar_apply, map_mul, smul_eq_mul, neg_mul, Complex.ofReal_neg, mul_neg] congr 1 rw [← Complex.exp_conj] simp only [map_mul, Complex.conj_I, Complex.conj_ofReal, mul_neg] calc ∫ x, 𝐞 (-(x * y)) • conj (f (-x)) = ∫ x, conj (𝐞 (x * y) • f (-x)) := by congr 1; ext x; exact h_conj x _ = conj (∫ x, 𝐞 (x * y) • f (-x)) := integral_conj _ = conj (∫ x, 𝐞 (-(x * y)) • f x) := by rw [← integral_neg_eq_self (fun x => 𝐞 (-(x * y)) • f x)] congr 2 with x; ring_nf /-- Smooth compactly supported function with non-negative Fourier transform via self-convolution. -/ lemma auto_cheby_exists_smooth_nonneg_fourier_kernel : ∃ (ψ : ℝ → ℂ), ContDiff ℝ ∞ ψ ∧ HasCompactSupport ψ ∧ (∀ y, 0 ≤ (𝓕 ψ y).re ∧ (𝓕 ψ y).im = 0) ∧ 0 < (𝓕 ψ 0).re := by obtain ⟨φ_real, hφSmooth, hφCompact, hφIcc, _, hφsupp⟩ := smooth_urysohn_support_Ioo (a := 1/2) (b := 1) (c := 1) (d := 2) (by norm_num) (by norm_num) let φ : ℝ → ℂ := Complex.ofReal ∘ φ_real let φ_rev : ℝ → ℂ := fun x ↦ conj (φ (-x)) let ψ_fun : ℝ → ℂ := convolution φ φ_rev (ContinuousLinearMap.mul ℂ ℂ) volume have hφSmooth' : ContDiff ℝ ∞ φ := contDiff_ofReal.comp hφSmooth have hφCompact' : HasCompactSupport φ := hφCompact.comp_left rfl have hφRevSmooth : ContDiff ℝ ∞ φ_rev := Complex.conjCLE.contDiff.comp (hφSmooth'.comp contDiff_neg) have hφRevCompact : HasCompactSupport φ_rev := (hφCompact'.comp_homeomorph (Homeomorph.neg ℝ)).comp_left (by simp) have hφInt : Integrable φ := hφSmooth'.continuous.integrable_of_hasCompactSupport hφCompact' have hφRevInt : Integrable φ_rev := hφRevSmooth.continuous.integrable_of_hasCompactSupport hφRevCompact have hψSmooth : ContDiff ℝ ∞ ψ_fun := by convert! hφRevCompact.contDiff_convolution_right (ContinuousLinearMap.mul ℝ ℂ) (hφSmooth'.continuous.locallyIntegrable (μ := volume)) hφRevSmooth have hψCompact : HasCompactSupport ψ_fun := HasCompactSupport.convolution (ContinuousLinearMap.mul ℂ ℂ) hφCompact' hφRevCompact refine ⟨ψ_fun, hψSmooth, hψCompact, fun y ↦ ?_, ?_⟩ · rw [Real.fourierIntegral_convolution hφInt hφRevInt, Pi.mul_apply, Real.fourierIntegral_conj_neg y, mul_comm, ← Complex.normSq_eq_conj_mul_self] exact ⟨Complex.normSq_nonneg _, rfl⟩ · have hφ_nonneg : ∀ x, 0 ≤ φ_real x := fun x ↦ by have hx := hφIcc x; by_cases h : x ∈ Set.Icc (1:ℝ) 1 · simp only [Set.indicator_of_mem h, Pi.one_apply] at hx; linarith · simp only [Set.indicator_of_notMem h] at hx; exact hx have hvol_supp : (1 : ENNReal) ≤ volume (Function.support φ_real) := by have hsub : Set.Ico (1:ℝ) 2 ⊆ Function.support φ_real := fun x hx ↦ hφsupp.symm ▸ Set.mem_Ioo.mpr ⟨by linarith [hx.1], hx.2⟩ calc _ = volume (Set.Ico (1:ℝ) 2) := by simp [Real.volume_Ico]; norm_num _ ≤ _ := volume.mono hsub have hφint_pos : 0 < ∫ x, φ_real x := (integral_pos_iff_support_of_nonneg_ae (.of_forall hφ_nonneg) (hφSmooth.continuous.integrable_of_hasCompactSupport hφCompact)).2 (lt_of_lt_of_le (by simp) hvol_supp) have hFφ0_re : 0 < (𝓕 φ 0).re := by simp only [φ, fourier_real_eq, mul_zero, neg_zero, AddChar.map_zero_eq_one, one_smul, Function.comp_apply] have hint : Integrable (fun x => (φ_real x : ℂ)) := (hφSmooth.continuous.integrable_of_hasCompactSupport hφCompact).ofReal calc (∫ x, (φ_real x : ℂ)).re = ∫ x, (φ_real x : ℂ).re := (integral_re hint).symm _ = ∫ x, φ_real x := by simp only [Complex.ofReal_re] _ > 0 := hφint_pos rw [Real.fourierIntegral_convolution hφInt hφRevInt, Pi.mul_apply, Real.fourierIntegral_conj_neg 0, mul_comm, ← Complex.normSq_eq_conj_mul_self] exact Complex.normSq_pos.2 (fun h ↦ (ne_of_gt hFφ0_re) (by simp [h])) /-- The series `∑ f(n)/n · 𝓕ψ(log(n/x)/(2π))` is summable for `x ≥ 1`. -/ lemma auto_cheby_fourier_summable : letI := @realFunctionCoeDict ∀ (hpos : 0 ≤ f) (hf : ∀ σ', 1 < σ' → Summable (nterm f σ')) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (ψ : ℝ → ℂ) (hψSmooth : ContDiff ℝ ∞ ψ) (hψCompact : HasCompactSupport ψ) (hψpos : ∀ y, 0 ≤ (𝓕 ψ y).re ∧ (𝓕 ψ y).im = 0) (x : ℝ) (hx : 1 ≤ x), Summable fun n ↦ (f n : ℂ) / n * 𝓕 ψ (1 / (2 * π) * Real.log (n / x)) := by letI := @realFunctionCoeDict letI := @CS.coeFunDict letI := @W1.coeFunDict letI := @W21.csDict intro hpos hf hG hG' ψ hψSmooth hψCompact hψpos x hx let ψCS : CS 2 ℂ := ⟨ψ, hψSmooth.of_le (by norm_cast), hψCompact⟩ let S : ℝ → ℂ := fun σ' ↦ ∑' n, term (f · : ℕ → ℂ) σ' n * 𝓕 ψCS.toFun (1 / (2 * π) * Real.log (n / x)) let Pole : ℝ → ℂ := fun σ' ↦ (A : ℂ) * (x ^ (1 - σ') : ℝ) * ∫ u in Set.Ici (-Real.log x), (rexp (-u * (σ' - 1)) : ℂ) * 𝓕 (W21.ofCS2 ψCS).toFun (u / (2 * π)) let RHS : ℝ → ℂ := fun σ' ↦ ∫ t : ℝ, G (σ' + t * I) * ψCS.toFun t * (x : ℂ) ^ (t * I) have l2 := limiting_fourier_lim2 (A := A) (x := x) ψCS hx have l3 := limiting_fourier_lim3 (G := G) hG ψCS hx have haux : (fun σ' ↦ S σ' - Pole σ') =ᶠ[𝓝[>] 1] RHS := eventually_nhdsWithin_of_forall fun σ' hσ' ↦ by simpa [S, Pole, RHS] using! limiting_fourier_aux hG' hf ψCS hx σ' hσ' have hS_tendsto : Tendsto S (𝓝[>] 1) (𝓝 (RHS 1 + A * ∫ u in Set.Ici (-Real.log x), 𝓕 (W21.ofCS2 ψCS).toFun (u / (2 * π)))) := by convert! (l3.congr' haux.symm).add l2 using 1; ext σ'; simp [S, Pole] have hbounded : BoundedAtFilter (𝓝[>] 1) (fun σ' ↦ ‖S σ'‖) := by simp only [BoundedAtFilter] let L := ‖RHS 1 + A * ∫ u in Set.Ici (-Real.log x), 𝓕 (W21.ofCS2 ψCS).toFun (u / (2 * π))‖ have : ∀ᶠ σ' in 𝓝[>] 1, ‖S σ'‖ < L + 1 := hS_tendsto.norm.eventually_lt tendsto_const_nhds (lt_add_one L) exact Asymptotics.IsBigO.of_bound (L + 1) (by filter_upwards [this] with σ h; simpa using h.le) let y : ℕ → ℝ := fun n ↦ (1 / (2 * π)) * Real.log (n / x) let w : ℕ → ℝ := fun n ↦ (𝓕 ψCS.toFun (y n)).re have hw : ∀ n, 0 ≤ w n := fun n ↦ (hψpos (y n)).1 let rt : ℝ → ℕ → ℝ := fun σ n ↦ if n = 0 then 0 else f n / (n : ℝ) ^ σ * w n have rt_nn σ n : 0 ≤ rt σ n := by simp only [rt]; split_ifs with hn · rfl · exact mul_nonneg (div_nonneg (hpos n) (Real.rpow_pos_of_pos (Nat.cast_pos.mpr (Nat.pos_of_ne_zero hn)) σ).le) (hw n) have hS_eq σ' (hσ' : 1 < σ') : S σ' = ↑(∑' n, rt σ' n) := by rw [Complex.ofReal_tsum]; apply tsum_congr; intro n simp only [rt, term, LSeries.term, y, w, one_div, mul_inv_rev] split_ifs with hn <;> simp only [hn, CharP.cast_eq_zero, Complex.ofReal_zero, zero_mul, Complex.ofReal_mul, Complex.ofReal_div] rw [Complex.ofReal_cpow (Nat.cast_nonneg n)]; congr 1 exact Complex.ext rfl (hψpos _).2 have hMono n : AntitoneOn (fun σ ↦ rt σ n) (Set.Ioi 1) := fun σ₁ _ σ₂ _ h ↦ by simp only [rt]; split_ifs with hn; · rfl apply mul_le_mul_of_nonneg_right _ (hw n) apply div_le_div_of_nonneg_left (hpos n) (Real.rpow_pos_of_pos (Nat.cast_pos.mpr (Nat.pos_of_ne_zero hn)) σ₁) exact Real.rpow_le_rpow_of_exponent_le (Nat.one_le_cast.mpr (Nat.pos_of_ne_zero hn)) h have hT_bdd : BoundedAtFilter (𝓝[>] 1) fun σ ↦ ∑' n, rt σ n := by rw [BoundedAtFilter, Asymptotics.isBigO_iff] at hbounded ⊢ obtain ⟨C, hC⟩ := hbounded refine ⟨C, ?_⟩ filter_upwards [hC, self_mem_nhdsWithin] with σ hnorm hσ rw [hS_eq σ hσ] at hnorm; simpa using hnorm have hSumm σ (hσ : 1 < σ) : Summable (rt σ ·) := by simpa [rt, w, y] using limiting_fourier_variant_lim1_aux ψCS hpos hf hψpos σ hσ have hSumm_1 : Summable (rt 1 ·) := by let σ_seq : ℕ → ℝ := fun k ↦ 1 + 1 / ((k : ℝ) + 1) have hσ_gt k : 1 < σ_seq k := by simp only [σ_seq, lt_add_iff_pos_right, one_div]; positivity have h_tendsto : Tendsto σ_seq atTop (𝓝[>] 1) := by rw [tendsto_nhdsWithin_iff] refine ⟨?_, by filter_upwards with k; exact hσ_gt k⟩ have : Tendsto (fun k : ℕ ↦ 1 / ((k : ℝ) + 1)) atTop (𝓝 0) := by simp only [one_div]; exact (tendsto_natCast_atTop_atTop.atTop_add tendsto_const_nhds).inv_tendsto_atTop simpa [σ_seq] using tendsto_const_nhds.add this have h_ptwise n : Tendsto (fun k ↦ rt (σ_seq k) n) atTop (𝓝 (rt 1 n)) := by simp only [rt]; split_ifs with hn; · exact tendsto_const_nhds refine ((tendsto_const_nhds.rpow (tendsto_nhdsWithin_iff.mp h_tendsto).1 (Or.inl ?_)).inv₀ (by simp [hn])).const_mul (f n) |>.mul_const (w n) exact (Nat.cast_pos.mpr (Nat.pos_of_ne_zero hn)).ne' obtain ⟨C, hC⟩ := Asymptotics.isBigO_iff.mp (hT_bdd.comp_tendsto h_tendsto) refine summable_of_sum_range_le (c := C) (rt_nn 1) fun m ↦ le_of_tendsto (tendsto_finsetSum _ fun i _ ↦ h_ptwise i) ?_ filter_upwards [h_tendsto.eventually self_mem_nhdsWithin, hC] with k hk hCk calc ∑ i ∈ Finset.range m, rt (σ_seq k) i ≤ ∑' n, rt (σ_seq k) n := (hSumm _ hk).sum_le_tsum _ fun n _ ↦ rt_nn _ n _ ≤ |∑' n, rt (σ_seq k) n| := le_abs_self _ _ ≤ C := by simpa using hCk rw [show (fun n ↦ (f n : ℂ) / n * 𝓕 ψ (1 / (2 * π) * Real.log (n / x))) = Complex.ofRealCLM ∘ (rt 1 ·) from ?_] · exact hSumm_1.map Complex.ofRealCLM Complex.ofRealCLM.continuous ext n; simp only [rt, Real.rpow_one, one_div, w, y, Function.comp_apply] split_ifs with hn; · simp [hn] have him0 : (𝓕 ψCS.toFun ((2 * π)⁻¹ * Real.log (n / x))).im = 0 := (hψpos _).2 have hre_eq : 𝓕 ψCS.toFun ((2 * π)⁻¹ * Real.log (n / x)) = Complex.ofReal ((𝓕 ψCS.toFun ((2 * π)⁻¹ * Real.log (n / x))).re) := by rw [← Complex.re_add_im (𝓕 ψCS.toFun _), him0]; simp conv_lhs => rw [show ψ = ψCS.toFun from rfl, hre_eq] simp only [Complex.ofRealCLM_apply, Complex.ofReal_div, Complex.ofReal_mul, Complex.ofReal_natCast] /-- Short interval bound from global filtered bound: if `∑ f(n)/n · 𝓕ψ(log(n/x)) ≤ B`, then `∑_{(1-ε)x < n ≤ x} f(n) ≤ Cx` for some `ε, C > 0`. -/ lemma auto_cheby_short_interval_bound : letI := @realFunctionCoeDict ∀ (hpos : 0 ≤ f) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}) (B : ℝ) (ψ : ℝ → ℂ) (hψSmooth : ContDiff ℝ ∞ ψ) (hψCompact : HasCompactSupport ψ) (hψpos : ∀ y, 0 ≤ (𝓕 ψ y).re ∧ (𝓕 ψ y).im = 0) (hψ0 : 0 < (𝓕 ψ 0).re) (hB_bound : ∀ x ≥ 1, ‖∑' n, f n / n * 𝓕 ψ (1 / (2 * Real.pi) * Real.log (n / x))‖ ≤ B), ∃ (ε : ℝ) (C : ℝ), ε > 0 ∧ ε < 1 ∧ C > 0 ∧ ∀ x ≥ 1, ∑' n, (f n) * (Set.indicator (Set.Ioc ((1 - ε) * x) x) (fun _ ↦ 1) (n : ℝ)) ≤ C * x := by letI := @realFunctionCoeDict intro hpos hf hG hG' B ψ hψSmooth hψCompact hψpos hψ0 hB_bound have hF : Continuous (𝓕 ψ) := VectorFourier.fourierIntegral_continuous Real.continuous_fourierChar (by continuity) (hψSmooth.continuous.integrable_of_hasCompactSupport hψCompact) have hg : Continuous fun y ↦ (𝓕 ψ y).re := Complex.continuous_re.comp hF obtain ⟨δ, hδpos, hball⟩ := Metric.mem_nhds_iff.1 <| hg.continuousAt.preimage_mem_nhds (IsOpen.mem_nhds isOpen_Ioi (half_lt_self hψ0)) let c := (𝓕 ψ 0).re / 2 have hcpos : 0 < c := by dsimp only [c]; linarith have h_psi_ge_c : ∀ y, |y| < δ → c ≤ (𝓕 ψ y).re := fun y hy ↦ (hball (mem_ball_zero_iff.mpr hy)).le let ε := 1 - Real.exp (-2 * π * δ) have hε : 0 < ε ∧ ε < 1 := by have h1 : Real.exp (-2 * π * δ) < 1 := Real.exp_lt_one_iff.mpr (by nlinarith [Real.pi_pos]) exact ⟨by simp only [ε]; linarith, by simp only [ε]; linarith [Real.exp_pos (-2 * π * δ)]⟩ have hB_nonneg : 0 ≤ B := (norm_nonneg _).trans (hB_bound 1 le_rfl) refine ⟨ε, B / c + 1, hε.1, hε.2, by positivity, fun x hx ↦ ?_⟩ have h_summable : Summable fun n ↦ (f n : ℂ) / n * 𝓕 ψ (1 / (2 * π) * Real.log (n / x)) := auto_cheby_fourier_summable hpos hf hG hG' ψ hψSmooth hψCompact hψpos x hx have hx_pos : 0 < x := by linarith have h_sum_lower : c / x * ∑' n, f n * Set.indicator (Set.Ioc ((1 - ε) * x) x) 1 (n : ℝ) ≤ ∑' n, f n / n * (𝓕 ψ (1 / (2 * π) * Real.log (n / x))).re := by rw [← tsum_mul_left] refine Summable.tsum_le_tsum (fun n ↦ ?_) ?_ ?_ · by_cases hn : (n : ℝ) ∈ Set.Ioc ((1 - ε) * x) x · rw [Set.indicator_of_mem hn, Pi.one_apply, mul_one] have hn_pos : 0 < (n : ℝ) := by nlinarith [hn.1, hε.2] let y := (1 / (2 * π)) * Real.log (n / x) have h_arg_small : |y| < δ := by have h2pi : 0 < 2 * π := by linarith [Real.pi_pos] simp only [y, abs_mul, abs_div, abs_one, abs_of_pos h2pi] field_simp [ne_of_gt h2pi]; rw [mul_comm, abs_lt] have h_log_lower : -2 * π * δ < Real.log (n / x) := by rw [← Real.log_exp (-2 * π * δ), Real.log_lt_log_iff (Real.exp_pos _) (by positivity)] have : Real.exp (-2 * π * δ) = 1 - ε := by simp only [ε]; ring rw [this]; field_simp; exact hn.1 have h_log_upper : Real.log (n / x) ≤ 0 := Real.log_nonpos (by positivity) (div_le_one_of_le₀ hn.2 hx_pos.le) constructor <;> nlinarith [Real.pi_pos] have h1 : x⁻¹ ≤ (n : ℝ)⁻¹ := by rw [inv_le_inv₀ hx_pos hn_pos]; exact hn.2 have h2 : c ≤ (𝓕 ψ y).re := h_psi_ge_c y h_arg_small have hfn : 0 ≤ f n := hpos n have hre : 0 ≤ (𝓕 ψ y).re := (hψpos y).1 have hn_inv : 0 ≤ (n : ℝ)⁻¹ := inv_nonneg.mpr hn_pos.le calc c / x * f n = c * x⁻¹ * f n := by rw [div_eq_mul_inv] _ ≤ c * (n : ℝ)⁻¹ * f n := by gcongr _ ≤ (𝓕 ψ y).re * (n : ℝ)⁻¹ * f n := by gcongr _ = (n : ℝ)⁻¹ * (𝓕 ψ y).re * f n := by ring _ = f n / n * (𝓕 ψ y).re := by ring · rw [Set.indicator_of_notMem hn, mul_zero, mul_zero] exact mul_nonneg (div_nonneg (hpos n) (Nat.cast_nonneg n)) (hψpos _).1 · refine summable_of_hasFiniteSupport <| (Set.finite_le_nat ⌊x⌋₊).subset fun n hn ↦ ?_ simp only [Function.mem_support, ne_eq, mul_eq_zero, not_or, Set.indicator_apply_ne_zero] at hn exact Nat.le_floor hn.2.2.1.2 · rw [← Complex.summable_ofReal]; convert h_summable using 1; ext n rw [Complex.ofReal_mul, Complex.ofReal_div] norm_cast rw [Complex.ofReal_mul] congr 1 apply Complex.ext · simp only [Complex.ofReal_re] · simp only [Complex.ofReal_im]; exact (hψpos _).2.symm have h_real_eq : ∑' n, f n / n * (𝓕 ψ (1 / (2 * π) * Real.log (n / x))).re = (∑' n, (f n : ℂ) / n * 𝓕 ψ (1 / (2 * π) * Real.log (n / x))).re := by rw [Complex.re_tsum h_summable]; congr with n rw [Complex.mul_re]; norm_cast; simp only [zero_mul, sub_zero] calc ∑' n, f n * Set.indicator (Set.Ioc ((1 - ε) * x) x) 1 (n : ℝ) = x / c * (c / x * ∑' n, f n * Set.indicator (Set.Ioc ((1 - ε) * x) x) 1 (n : ℝ)) := by field_simp [ne_of_gt hcpos, ne_of_gt hx_pos] _ ≤ x / c * B := by gcongr; rw [h_real_eq] at h_sum_lower exact h_sum_lower.trans ((Complex.re_le_norm _).trans (hB_bound x hx)) _ = (B / c) * x := by field_simp [ne_of_gt hcpos] _ ≤ (B / c + 1) * x := by nlinarith /-- Bootstraps short interval bounds to global Chebyshev bound via strong induction. If `∑_{(1-ε)x < n ≤ x} f(n) ≤ Cx` for all `x ≥ 1`, then `∑_{n ≤ x} f(n) = O(x)`. -/ lemma auto_cheby_bootstrap_induction : letI := @realFunctionCoeDict ∀ (hpos : 0 ≤ f) (h_short : ∃ (ε : ℝ) (C : ℝ), ε > 0 ∧ ε < 1 ∧ C > 0 ∧ ∀ x ≥ 1, ∑' n, (f n) * (Set.indicator (Set.Ioc ((1 - ε) * x) x) (fun _ ↦ 1) (n : ℝ)) ≤ C * x), cheby f := by letI := @realFunctionCoeDict intro hpos h_short obtain ⟨ε, C₀, hε, hε1, hC₀, h_bound⟩ := h_short let C := C₀ / ε + f 0 + 1 have hf0 : (0 : ℝ) ≤ f 0 := hpos 0 have hdiv : 0 ≤ C₀ / ε := div_nonneg hC₀.le hε.le have hC : 0 ≤ C := by linarith refine ⟨C, fun n ↦ ?_⟩ induction n using Nat.strong_induction_on with | h n ih => rcases lt_or_ge n 2 with hn | hn · interval_cases n · simp [cumsum] · simp only [cumsum, Finset.sum_range_one, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hf0, Nat.cast_one, mul_one, C] linarith let x := (n : ℝ) - 1 have hx : x ≥ 1 := by simp only [x, ge_iff_le, le_sub_iff_add_le]; norm_cast let m := ⌊(1 - ε) * x⌋₊ + 1 have hm_lt : m < n := by simp only [m, x] have h1 : (1 - ε) * (n - 1 : ℝ) < (n - 1 : ℕ) := by calc (1 - ε) * (↑n - 1) < 1 * (↑n - 1) := by gcongr; linarith _ = ↑n - 1 := by ring _ = ↑(n - 1) := by simp [Nat.cast_sub (by omega : 1 ≤ n)] have h2 : ⌊(1 - ε) * (n - 1 : ℝ)⌋₊ < n - 1 := (Nat.floor_lt (mul_nonneg (by linarith) (by linarith : (0 : ℝ) ≤ n - 1))).mpr h1 omega have hm_gt : (m : ℝ) > (1 - ε) * x := by simp only [m, Nat.cast_add, Nat.cast_one, gt_iff_lt] exact Nat.lt_floor_add_one ((1 - ε) * x) have h_decomp : cumsum (fun k ↦ ‖(f k : ℂ)‖) n = cumsum (fun k ↦ ‖(f k : ℂ)‖) m + ∑ k ∈ Finset.Ico m n, f k := by simp only [cumsum, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (hpos _), Finset.sum_range_add_sum_Ico _ (by omega : m ≤ n)] have h_Ico : ∑ k ∈ Finset.Ico m n, f k ≤ C₀ * x := by calc ∑ k ∈ Finset.Ico m n, f k = ∑ k ∈ Finset.Ico m n, f k * Set.indicator (Set.Ioc ((1 - ε) * x) x) 1 (k : ℝ) := by refine Finset.sum_congr rfl fun k hk ↦ ?_ have ⟨hkm, hkn⟩ := Finset.mem_Ico.mp hk have hk_gt : (k : ℝ) > (1 - ε) * x := by linarith [hm_gt, (Nat.cast_le (α := ℝ)).mpr hkm] have hk_le : (k : ℝ) ≤ x := by have h1 : k ≤ n - 1 := Nat.le_pred_of_lt hkn have h2 : (k : ℝ) ≤ (n - 1 : ℕ) := by exact_mod_cast h1 simp only [Nat.cast_sub (by omega : 1 ≤ n), Nat.cast_one, x] at h2 ⊢; exact h2 simp only [Set.indicator_of_mem (Set.mem_Ioc.mpr ⟨hk_gt, hk_le⟩), Pi.one_apply, mul_one] _ ≤ ∑' k, f k * Set.indicator (Set.Ioc ((1 - ε) * x) x) 1 (k : ℝ) := by refine Summable.sum_le_tsum _ (fun k _ ↦ mul_nonneg (hpos k) (Set.indicator_nonneg (by simp) _)) ?_ refine summable_of_hasFiniteSupport <| (Set.finite_le_nat ⌊x⌋₊).subset fun k hk ↦ ?_ simp only [Function.mem_support, ne_eq, mul_eq_zero, not_or, Set.indicator_apply_ne_zero] at hk exact Nat.le_floor hk.2.1.2 _ ≤ C₀ * x := h_bound x hx have hm_le : (m : ℝ) ≤ (1 - ε) * x + 1 := by have hpos' : 0 ≤ (1 - ε) * x := mul_nonneg (by linarith) (by linarith : (0 : ℝ) ≤ x) simp only [m, Nat.cast_add, Nat.cast_one] linarith [Nat.floor_le hpos'] have hnorm : ∀ k, ‖(f k : ℂ)‖ = f k := fun k ↦ by simp [abs_of_nonneg (hpos k)] simp only [hnorm] at h_decomp ih ⊢ calc cumsum f n = cumsum f m + ∑ k ∈ Finset.Ico m n, f k := h_decomp _ ≤ C * m + C₀ * x := by linarith [ih m hm_lt, h_Ico] _ ≤ C * ((1 - ε) * x + 1) + C₀ * x := by nlinarith [hC] _ = (C * (1 - ε) + C₀) * x + C := by ring _ ≤ C * x + C := by have : C₀ ≤ C * ε := by calc C₀ = (C₀ / ε) * ε := by field_simp [ne_of_gt hε] _ ≤ (C₀ / ε + f 0 + 1) * ε := by gcongr; linarith [hpos 0] _ = C * ε := by simp only [C] nlinarith [hε, hε1, hx] _ ≤ C * n := by simp only [x]; ring_nf; linarith [hC] lemma auto_cheby : letI := @realFunctionCoeDict ∀ (hpos : 0 ≤ f) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}), cheby f := by letI := @realFunctionCoeDict intro hpos hf hG hG' obtain ⟨ψ_fun, hψSmooth, hψCompact, hψpos, hψ0⟩ := auto_cheby_exists_smooth_nonneg_fourier_kernel obtain ⟨B, hB⟩ := crude_upper_bound hpos hG hG' hf ⟨ψ_fun, hψSmooth.of_le ENat.LEInfty.out, hψCompact⟩ hψpos exact auto_cheby_bootstrap_induction hpos <| auto_cheby_short_interval_bound hpos hf hG hG' B ψ_fun hψSmooth hψCompact hψpos hψ0 fun x hx ↦ hB x (by linarith) theorem WienerIkeharaTheorem'' : letI := @realFunctionCoeDict ∀ (hpos : 0 ≤ f) (hf : ∀ (σ' : ℝ), 1 < σ' → Summable (nterm f σ')) (hG : ContinuousOn G {s | 1 ≤ s.re}) (hG' : Set.EqOn G (fun s ↦ LSeries f s - A / (s - 1)) {s | 1 < s.re}), Tendsto (fun N => cumsum f N / N) atTop (𝓝 A) := by letI := @realFunctionCoeDict intro hpos hf hG hG' exact WienerIkeharaTheorem' hpos hf (auto_cheby (f := f) (A := A) (G := G) hpos hf hG hG') hG hG' end auto_cheby theorem WeakPNT_character {q a : ℕ} (hq : q ≥ 1) (ha : Nat.Coprime a q) (ha' : a < q) {s : ℂ} (hs : 1 < s.re) : LSeries (fun n ↦ if n % q = a then Λ n else 0) s = - (∑' χ : DirichletCharacter ℂ q, ((starRingEnd ℂ) (χ a) * ((deriv (LSeries (fun n:ℕ ↦ χ n)) s)) / (LSeries (fun n:ℕ ↦ χ n) s))) / (Nat.totient q : ℂ) := by have : NeZero q := ⟨by omega⟩ convert vonMangoldt.LSeries_residueClass_eq ((ZMod.isUnit_iff_coprime a q).mpr ha) hs using 1 · congr with n have : n % q = a ↔ (n : ZMod q) = a := by rw [ZMod.natCast_eq_natCast_iff', Nat.mod_eq_of_lt ha'] simp [this] split_ifs <;> simp [*] · rw [div_eq_inv_mul, neg_mul_comm, tsum_fintype] congr 3 with χ rw [DirichletCharacter.deriv_LFunction_eq_deriv_LSeries _ hs, DirichletCharacter.LFunction_eq_LSeries _ hs, mul_div] congr 2 rw [starRingEnd_apply, MulChar.star_apply', MulChar.inv_apply_eq_inv', ← ZMod.coe_unitOfCoprime a ha, ZMod.inv_coe_unit, map_units_inv] theorem WeakPNT_AP_prelim {q : ℕ} {a : ℕ} (hq : q ≥ 1) (ha : Nat.Coprime a q) (ha' : a < q) : ∃ G: ℂ → ℂ, (ContinuousOn G {s | 1 ≤ s.re}) ∧ (Set.EqOn G (fun s ↦ LSeries (fun n ↦ if n % q = a then Λ n else 0) s - 1 / ((Nat.totient q) * (s - 1))) {s | 1 < s.re}) := by have : NeZero q := NeZero.of_pos hq have hG : ∃ G : ℂ → ℂ, ContinuousOn G {s | 1 ≤ s.re} ∧ Set.EqOn G (fun s ↦ LSeries (fun n ↦ if (n : ZMod q) = a then Λ n else 0) s - (q.totient : ℂ)⁻¹ / (s - 1)) {s | 1 < s.re} := by use vonMangoldt.LFunctionResidueClassAux (a : ZMod q), vonMangoldt.continuousOn_LFunctionResidueClassAux (q := q) (a := a) have := vonMangoldt.eqOn_LFunctionResidueClassAux ((ZMod.isUnit_iff_coprime a q).mpr ha) convert this using 6; split <;> simp_all convert hG using 6 · simp [ZMod.natCast_eq_natCast_iff', Nat.mod_eq_of_lt ha'] · rw [inv_eq_one_div, div_div] /-- The von Mangoldt function divided by `n ^ s` is summable for `s > 1`. -/ lemma summable_vonMangoldt_div_rpow {s : ℝ} (hs : 1 < s) : Summable (fun n ↦ Λ n / n ^ s) := by have h_log_bound : ∀ n : ℕ, (Λ n : ℝ) ≤ Real.log n := fun n ↦ vonMangoldt_le_log suffices h_log_sum : Summable fun n : ℕ ↦ Real.log n / (n : ℝ) ^ s by exact .of_nonneg_of_le (fun n ↦ div_nonneg vonMangoldt_nonneg (by positivity)) (fun n ↦ div_le_div_of_nonneg_right (h_log_bound n) (by positivity)) h_log_sum have h_log_le_n_eps : ∀ ε > 0, ∃ C > 0, ∀ n : ℕ, n ≥ 2 → Real.log n / (n : ℝ) ^ s ≤ C * (n : ℝ) ^ (ε - s) := by intro ε hε_pos obtain ⟨C, hC_pos, hC⟩ : ∃ C > 0, ∀ n : ℕ, n ≥ 2 → Real.log n ≤ C * (n : ℝ) ^ ε := by refine ⟨1 / ε, by positivity, fun n hn ↦ ?_⟩ have := log_le_sub_one_of_pos (by positivity : 0 < (n : ℝ) ^ ε) rw [log_rpow (by positivity)] at this nlinarith [rpow_pos_of_pos (by positivity : 0 < (n : ℝ)) ε, mul_div_cancel₀ 1 hε_pos.ne'] refine ⟨C, hC_pos, fun n hn ↦ ?_⟩ rw [rpow_sub (by positivity)] exact le_trans (div_le_div_of_nonneg_right (hC n hn) (by positivity)) (by rw [div_eq_mul_inv]; ring_nf; norm_num) obtain ⟨C, _, hC⟩ : ∃ C > 0, ∀ n : ℕ, n ≥ 2 → Real.log n / (n : ℝ) ^ s ≤ C * (n : ℝ) ^ ((s - 1) / 2 - s) := h_log_le_n_eps ((s - 1) / 2) (by linarith) rw [← summable_nat_add_iff 2] exact Summable.of_nonneg_of_le (fun n ↦ div_nonneg (log_nonneg (by norm_cast; omega)) (rpow_nonneg (by positivity) _)) (fun n ↦ hC _ (by omega)) (Summable.mul_left _ <| by simpa using summable_nat_add_iff 2 |>.2 <| summable_nat_rpow.2 <| by linarith) theorem WeakPNT_AP {q : ℕ} {a : ℕ} (hq : q ≥ 1) (ha : a.Coprime q) (ha' : a < q) : Tendsto (fun N ↦ cumsum (fun n ↦ if n % q = a then Λ n else 0) N / N) atTop (𝓝 (1 / q.totient)) := by letI := @realFunctionCoeDict have h_summable : ∀ s : ℝ, 1 < s → Summable (fun n ↦ (if n % q = a then Λ n else 0) / n ^ s) := by intro s hs refine .of_nonneg_of_le (fun n ↦ ?_) (fun n ↦ ?_) (summable_vonMangoldt_div_rpow hs) · split_ifs <;> positivity · split_ifs <;> norm_num; exact div_nonneg vonMangoldt_nonneg (by positivity) obtain ⟨G, hG₁, hG₂⟩ := WeakPNT_AP_prelim hq ha ha' convert WienerIkeharaTheorem'' _ _ _ _ using 1 · use G · intro n simp_all only [ge_iff_le, one_div, mul_inv_rev, Pi.ofNat_apply] split next h => subst h; simp_all only [vonMangoldt_nonneg] next h => simp_all only [le_refl] · intro σ' hσ' specialize h_summable σ' hσ' simp_all only [ge_iff_le, one_div, mul_inv_rev] convert h_summable using 1 ext simp only [nterm, norm_real, norm_eq_abs] ring_nf split_ifs <;> simp [*, mul_comm] · assumption · convert hG₂ using 3 · exact tsum_congr fun n ↦ by cases n <;> aesop · norm_num [div_eq_mul_inv, mul_assoc, mul_comm, mul_left_comm] end BodyFile026 -- Source: DistanceCounts/PrimeProgressions.lean section BodyFile027 noncomputable section open Filter Finset ArithmeticFunction open scoped Topology namespace DistanceCounts.PrimeProgressions /-- The logarithmic weight of a rational prime in the indicated class modulo four. -/ def primeWeight (a n : ℕ) : ℝ := if n.Prime ∧ n % 4 = a then Real.log n else 0 /-- The von Mangoldt weight in the indicated class modulo four. -/ def mangoldtWeight (a n : ℕ) : ℝ := if n % 4 = a then Λ n else 0 /-- The exclusive-endpoint prime sum, matching the endpoint convention of `WeakPNT_AP`. -/ def theta (a N : ℕ) : ℝ := ∑ n ∈ range N, primeWeight a n def psi (a N : ℕ) : ℝ := ∑ n ∈ range N, mangoldtWeight a n /-- The reciprocal sum uses the inclusive endpoint required in the normal-order statement. -/ def splitPrimeReciprocal (N : ℕ) : ℝ := ∑ p ∈ (range (N + 1)).filter (fun p => p.Prime ∧ p % 4 = 1), 1 / (p : ℝ) lemma primeWeight_le_mangoldtWeight (a n : ℕ) : primeWeight a n ≤ mangoldtWeight a n := by by_cases hp : n.Prime · simp [primeWeight, mangoldtWeight, hp, vonMangoldt_apply_prime hp] · simp only [primeWeight, hp, false_and, ↓reduceIte, mangoldtWeight] split · exact vonMangoldt_nonneg · exact le_refl 0 lemma primePowerRemainder_nonneg (n : ℕ) : 0 ≤ Λ n - if n.Prime then Real.log n else 0 := by by_cases hp : n.Prime · simp [hp, vonMangoldt_apply_prime hp] · simpa [hp] using (vonMangoldt_nonneg (n := n)) lemma primePowerRemainder_le (a n : ℕ) : mangoldtWeight a n - primeWeight a n ≤ Λ n - if n.Prime then Real.log n else 0 := by by_cases ha : n % 4 = a · simp [mangoldtWeight, primeWeight, ha] · simpa [mangoldtWeight, primeWeight, ha] using primePowerRemainder_nonneg n /-- Discarding residue classes can only reduce the nonprime prime-power error. -/ lemma psi_sub_theta_bounds (a N : ℕ) : 0 ≤ psi a N - theta a N ∧ psi a N - theta a N ≤ Chebyshev.psi N - Chebyshev.theta N := by constructor · exact sub_nonneg.mpr (sum_le_sum fun n _ => primeWeight_le_mangoldtWeight a n) · calc psi a N - theta a N = ∑ n ∈ range N, (mangoldtWeight a n - primeWeight a n) := by simp only [psi, theta, sum_sub_distrib] _ ≤ ∑ n ∈ range N, (Λ n - if n.Prime then Real.log n else 0) := sum_le_sum fun n _ => primePowerRemainder_le a n _ ≤ ∑ n ∈ range (N + 1), (Λ n - if n.Prime then Real.log n else 0) := sum_le_sum_of_subset_of_nonneg (range_mono (by omega)) (fun n _ _ => primePowerRemainder_nonneg n) _ = Chebyshev.psi N - Chebyshev.theta N := by simp only [Chebyshev.psi_eq_sum_Icc, Chebyshev.theta_eq_sum_Icc, Nat.floor_natCast, Nat.range_succ_eq_Icc_zero, sum_sub_distrib, sum_filter] /-- The prime-power contribution is negligible, using mathlib's `O(sqrt x)` estimate. -/ lemma tendsto_primePowerRemainder (a : ℕ) : Tendsto (fun N : ℕ => (psi a N - theta a N) / N) atTop (𝓝 0) := by obtain ⟨C, hC⟩ := Chebyshev.psi_sub_theta_le_mul_sqrt have hlim : Tendsto (fun N : ℕ => C * Real.sqrt N / N) atTop (𝓝 0) := by have hs := tendsto_inv_atTop_zero.comp (Real.tendsto_sqrt_atTop.comp (tendsto_natCast_atTop_atTop : Tendsto (fun N : ℕ => (N : ℝ)) atTop atTop)) simpa only [mul_div_assoc, Real.sqrt_div_self, mul_zero] using (tendsto_const_nhds.mul hs : Tendsto (fun N : ℕ => C * (Real.sqrt N)⁻¹) atTop (𝓝 (C * 0))) refine tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds hlim ?_ ?_ · intro N exact div_nonneg (psi_sub_theta_bounds a N).1 (Nat.cast_nonneg N) · intro N exact div_le_div_of_nonneg_right ((psi_sub_theta_bounds a N).2.trans (hC N)) (Nat.cast_nonneg N) lemma tendsto_psi_div (a : ℕ) (ha : a.Coprime 4) (hlt : a < 4) : Tendsto (fun N : ℕ => psi a N / N) atTop (𝓝 (1 / 2 : ℝ)) := by simpa only [psi, mangoldtWeight, cumsum, show Nat.totient 4 = 2 by decide, Nat.cast_ofNat] using (WeakPNT_AP (q := 4) (a := a) (by decide) ha hlt) /-- The rational-prime AP asymptotic, with prime powers removed rather than assumed away. -/ lemma tendsto_theta_div (a : ℕ) (ha : a.Coprime 4) (hlt : a < 4) : Tendsto (fun N : ℕ => theta a N / N) atTop (𝓝 (1 / 2 : ℝ)) := by have h := (tendsto_psi_div a ha hlt).sub (tendsto_primePowerRemainder a) simpa only [sub_div, sub_sub_cancel, sub_zero] using h lemma tendsto_theta_three_div : Tendsto (fun N : ℕ => theta 3 N / N) atTop (𝓝 (1 / 2 : ℝ)) := tendsto_theta_div 3 (by decide) (by decide) lemma tendsto_theta_one_div : Tendsto (fun N : ℕ => theta 1 N / N) atTop (𝓝 (1 / 2 : ℝ)) := tendsto_theta_div 1 (by decide) (by decide) /-- For every sufficiently large natural N there is a rational prime congruent to three modulo four between N and 2N. In fact the upper endpoint is strict. -/ theorem eventually_exists_prime_three_mod_four : ∀ᶠ N : ℕ in atTop, ∃ p : ℕ, p.Prime ∧ p % 4 = 3 ∧ N ≤ p ∧ p < 2 * N := by have hdouble : Tendsto (fun N : ℕ => 2 * N) atTop atTop := tendsto_atTop_mono (fun N : ℕ => show N ≤ 2 * N by omega) tendsto_id have hlow := (tendsto_theta_three_div.comp hdouble).eventually (lt_mem_nhds (show (3 / 8 : ℝ) < 1 / 2 by norm_num)) have hupp := tendsto_theta_three_div.eventually (gt_mem_nhds (show (1 / 2 : ℝ) < 5 / 8 by norm_num)) filter_upwards [hlow, hupp, eventually_gt_atTop 0] with N hlow hupp hN have hNr : (0 : ℝ) < N := by exact_mod_cast hN have h2Nr : (0 : ℝ) < (2 * N : ℕ) := by positivity have hlow' := (lt_div_iff₀ h2Nr).mp hlow have hupp' := (div_lt_iff₀ hNr).mp hupp push_cast at hlow' have htheta : theta 3 N < theta 3 (2 * N) := by nlinarith by_contra hnone have hzero : ∀ p ∈ range (2 * N), p ∉ range N → primeWeight 3 p = 0 := by intro p hp hpN have hpupper : p < 2 * N := mem_range.mp hp have hplower : N ≤ p := Nat.le_of_not_gt (by simpa only [mem_range] using hpN) have hbad : ¬(p.Prime ∧ p % 4 = 3) := by intro hpprime exact hnone ⟨p, hpprime.1, hpprime.2, hplower, hpupper⟩ simp [primeWeight, hbad] have heq : theta 3 N = theta 3 (2 * N) := sum_subset (range_mono (by omega)) hzero exact (ne_of_lt htheta) heq end DistanceCounts.PrimeProgressions end end BodyFile027 -- Source: DistanceCounts/MertensTransfer.lean section BodyFile028 noncomputable section open Filter Finset open scoped Topology namespace DistanceCounts.MertensTransfer /-- The reciprocal logarithmic kernel, with the usual total real division convention. -/ def kernel (x : ℝ) : ℝ := 1 / (x * Real.log x) lemma kernel_pos {x : ℝ} (hx : 2 ≤ x) : 0 < kernel x := by exact one_div_pos.mpr (mul_pos (by linarith) (Real.log_pos (by linarith))) lemma kernel_antitone : AntitoneOn kernel (Set.Ici 2) := by intro x hx y hy hxy change 2 ≤ x at hx change 2 ≤ y at hy apply one_div_le_one_div_of_le · exact mul_pos (by linarith [hx]) (Real.log_pos (by linarith [hx])) · exact mul_le_mul hxy (Real.log_le_log (by linarith [hx]) hxy) (Real.log_pos (by linarith [hx])).le (by linarith [hy]) lemma integral_kernel {y : ℝ} (hy : 2 ≤ y) : (∫ x in (2 : ℝ)..y, kernel x) = Real.log (Real.log y) - Real.log (Real.log 2) := by have hanti : AntitoneOn kernel (Set.uIcc 2 y) := by rw [Set.uIcc_of_le hy] exact kernel_antitone.mono Set.Icc_subset_Ici_self apply intervalIntegral.integral_eq_sub_of_hasDerivAt _ hanti.intervalIntegrable intro x hx rw [Set.uIcc_of_le hy] at hx have hx0 : x ≠ 0 := by linarith [hx.1] have hx1 : x ≠ 1 := by linarith [hx.1] have hxm : x ≠ -1 := by linarith [hx.1] simpa [kernel, one_div, div_eq_mul_inv, mul_inv_rev, mul_comm] using Real.hasDerivAt_log_log hx0 hx1 hxm /-- Integral comparison with an error bounded independently of the endpoint. -/ lemma kernel_sum_bounds {N : ℕ} (hN : 2 ≤ N) : Real.log (Real.log N) - Real.log (Real.log 2) ≤ ∑ k ∈ Ico 2 N, kernel k ∧ (∑ k ∈ Ico 2 N, kernel k) ≤ Real.log (Real.log N) - Real.log (Real.log 2) + kernel 2 := by have hNr : (2 : ℝ) ≤ N := by exact_mod_cast hN have ha : AntitoneOn kernel (Set.Icc (2 : ℝ) N) := kernel_antitone.mono Set.Icc_subset_Ici_self have hlo := ha.integral_le_sum_Ico hN have hhi := ha.sum_le_integral_Ico hN norm_num only [Nat.cast_ofNat] at hlo hhi rw [integral_kernel hNr] at hlo hhi have hshift : (∑ k ∈ Ico 2 N, kernel (k + 1 : ℕ)) = (∑ k ∈ Ico 2 N, kernel k) + kernel N - kernel 2 := by rw [Finset.sum_Ico_add' (fun k : ℕ => kernel k) 2 N 1] have ht := sum_Ico_succ_top hN (fun k : ℕ => kernel k) have hb := sum_eq_sum_Ico_succ_bot (show 2 < N + 1 by omega) (fun k : ℕ => kernel k) norm_num only [Nat.cast_ofNat] at hb linarith rw [hshift] at hhi exact ⟨hlo, by linarith [kernel_pos hNr]⟩ /-- Replacing the first two kernel values by its value at two makes it antitone everywhere. -/ def weight (n : ℕ) : ℝ := kernel (max n 2 : ℕ) lemma weight_pos (n : ℕ) : 0 < weight n := by apply kernel_pos exact_mod_cast le_max_right n 2 lemma weight_antitone : Antitone weight := by intro m n hmn apply kernel_antitone · change (2 : ℝ) ≤ (max m 2 : ℕ) exact_mod_cast le_max_right m 2 · change (2 : ℝ) ≤ (max n 2 : ℕ) exact_mod_cast le_max_right n 2 · exact_mod_cast max_le_max_right 2 hmn lemma weight_eq {n : ℕ} (hn : 2 ≤ n) : weight n = kernel n := by simp [weight, max_eq_left hn] lemma weight_sum_eq {N : ℕ} (hN : 2 ≤ N) : (∑ k ∈ range N, weight k) = 2 * kernel 2 + ∑ k ∈ Ico 2 N, kernel k := by rw [← sum_range_add_sum_Ico weight hN] congr 1 · norm_num [Finset.sum_range_succ, weight] ring · exact sum_congr rfl fun k hk => weight_eq (mem_Ico.mp hk).1 lemma tendsto_loglog : Tendsto (fun N : ℕ => Real.log (Real.log N)) atTop atTop := Real.tendsto_log_atTop.comp (Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop) lemma tendsto_const_div_loglog (C : ℝ) : Tendsto (fun N : ℕ => C / Real.log (Real.log N)) atTop (𝓝 0) := by simpa [div_eq_mul_inv] using (tendsto_const_nhds.mul (tendsto_inv_atTop_zero.comp tendsto_loglog) : Tendsto (fun N : ℕ => C * (Real.log (Real.log N))⁻¹) atTop (𝓝 (C * 0))) /-- The logarithmic harmonic sum has leading coefficient one. -/ theorem tendsto_weight_sum_div_loglog : Tendsto (fun N : ℕ => (∑ k ∈ range N, weight k) / Real.log (Real.log N)) atTop (𝓝 1) := by have hlow : Tendsto (fun N : ℕ => 1 + (2 * kernel 2 - Real.log (Real.log 2)) / Real.log (Real.log N)) atTop (𝓝 1) := by simpa using tendsto_const_nhds.add (tendsto_const_div_loglog (2 * kernel 2 - Real.log (Real.log 2))) have hupp : Tendsto (fun N : ℕ => 1 + (3 * kernel 2 - Real.log (Real.log 2)) / Real.log (Real.log N)) atTop (𝓝 1) := by simpa using tendsto_const_nhds.add (tendsto_const_div_loglog (3 * kernel 2 - Real.log (Real.log 2))) apply tendsto_of_tendsto_of_tendsto_of_le_of_le' hlow hupp · filter_upwards [eventually_ge_atTop 2, tendsto_loglog.eventually (eventually_gt_atTop 0)] with N hN hpos have h := (kernel_sum_bounds hN).1 rw [weight_sum_eq hN] apply (le_div_iff₀ hpos).mpr rw [add_mul, one_mul, div_mul_cancel₀ _ hpos.ne'] linarith · filter_upwards [eventually_ge_atTop 2, tendsto_loglog.eventually (eventually_gt_atTop 0)] with N hN hpos have h := (kernel_sum_bounds hN).2 rw [weight_sum_eq hN] apply (div_le_iff₀ hpos).mpr rw [add_mul, one_mul, div_mul_cancel₀ _ hpos.ne'] linarith /-- Abel summation in a form whose coefficients are all nonnegative. -/ lemma sum_mul_by_parts (w a : ℕ → ℝ) (n : ℕ) : (∑ k ∈ range (n + 1), w k * a k) = w n * (∑ k ∈ range (n + 1), a k) + ∑ k ∈ range n, (w k - w (k + 1)) * (∑ j ∈ range (k + 1), a j) := by have h := sum_range_by_parts w a (n + 1) simp only [Nat.add_sub_cancel, smul_eq_mul] at h rw [h, sub_eq_add_neg, ← sum_neg_distrib] congr 1 exact sum_congr rfl fun k _ => by ring /-- Decreasing nonnegative weights preserve comparison of every prefix sum. -/ lemma sum_mul_le_of_prefix_le (w a b : ℕ → ℝ) (hw : Antitone w) (hw0 : ∀ n, 0 ≤ w n) (hab : ∀ n, (∑ k ∈ range n, a k) ≤ ∑ k ∈ range n, b k) (N : ℕ) : (∑ k ∈ range N, w k * a k) ≤ ∑ k ∈ range N, w k * b k := by cases N with | zero => simp | succ n => rw [sum_mul_by_parts, sum_mul_by_parts] apply add_le_add (mul_le_mul_of_nonneg_left (hab _) (hw0 _)) exact sum_le_sum fun k _ => mul_le_mul_of_nonneg_left (hab _) (sub_nonneg.mpr (hw (Nat.le_succ k))) lemma affine_prefix_bound {a : ℕ → ℝ} (ha : Tendsto (fun N : ℕ => (∑ k ∈ range N, a k) / N) atTop (𝓝 0)) {ε : ℝ} (hε : 0 < ε) : ∃ C : ℝ, 0 ≤ C ∧ ∀ N : ℕ, |∑ k ∈ range N, a k| ≤ ε * N + C := by obtain ⟨K, hK⟩ := Metric.tendsto_atTop.mp ha ε hε let C : ℝ := ∑ n ∈ range K, |∑ k ∈ range n, a k| have hC : 0 ≤ C := sum_nonneg fun _ _ => abs_nonneg _ refine ⟨C, hC, fun N => ?_⟩ by_cases hN : K ≤ N · by_cases hN0 : N = 0 · simp [hN0, hC] have hp : (0 : ℝ) < N := by exact_mod_cast Nat.pos_of_ne_zero hN0 have h := hK N hN rw [Real.dist_eq, sub_zero, abs_div, abs_of_pos hp] at h have := (div_lt_iff₀ hp).mp h linarith · have hmem : N ∈ range K := mem_range.mpr (by omega) have hle : |∑ k ∈ range N, a k| ≤ C := single_le_sum (fun n _ => abs_nonneg (∑ k ∈ range n, a k)) hmem exact hle.trans (le_add_of_nonneg_left (mul_nonneg hε.le (Nat.cast_nonneg N))) lemma weighted_affine_bound (w a : ℕ → ℝ) (hw : Antitone w) (hw0 : ∀ n, 0 ≤ w n) {ε C : ℝ} (hC : 0 ≤ C) (ha : ∀ N : ℕ, |∑ k ∈ range N, a k| ≤ ε * N + C) (N : ℕ) : |∑ k ∈ range N, w k * a k| ≤ ε * (∑ k ∈ range N, w k) + C * w 0 := by let b : ℕ → ℝ := fun k => ε + if k = 0 then C else 0 have hb (n : ℕ) (hn : n ≠ 0) : (∑ k ∈ range n, b k) = ε * n + C := by simp [b, sum_add_distrib, hn, Nat.pos_of_ne_zero hn, nsmul_eq_mul, mul_comm] have hupper : ∀ n, (∑ k ∈ range n, a k) ≤ ∑ k ∈ range n, b k := by intro n by_cases hn : n = 0 · simp [hn] · rw [hb n hn] exact (le_abs_self _).trans (ha n) have hlower : ∀ n, (∑ k ∈ range n, -a k) ≤ ∑ k ∈ range n, b k := by intro n by_cases hn : n = 0 · simp [hn] · rw [hb n hn, sum_neg_distrib] exact (neg_le_abs _).trans (ha n) have hup := sum_mul_le_of_prefix_le w a b hw hw0 hupper N have hlo := sum_mul_le_of_prefix_le w (fun k => -a k) b hw hw0 hlower N have hwb : (∑ k ∈ range N, w k * b k) ≤ ε * (∑ k ∈ range N, w k) + C * w 0 := by by_cases hN : N = 0 · simp [hN, mul_nonneg hC (hw0 0)] · have hspike : (∑ k ∈ range N, w k * (if k = 0 then C else 0)) = w 0 * C := by simp [mul_ite, Nat.pos_of_ne_zero hN] simp only [b, mul_add, sum_add_distrib] rw [← Finset.sum_mul, hspike] exact le_of_eq (by ring) apply abs_le.mpr constructor · simp only [mul_neg, sum_neg_distrib] at hlo linarith [hlo.trans hwb] · exact hup.trans hwb lemma tendsto_weighted_zero {a : ℕ → ℝ} (ha : Tendsto (fun N : ℕ => (∑ k ∈ range N, a k) / N) atTop (𝓝 0)) : Tendsto (fun N : ℕ => (∑ k ∈ range N, weight k * a k) / Real.log (Real.log N)) atTop (𝓝 0) := by apply Metric.tendsto_nhds.mpr intro δ hδ obtain ⟨C, hC, hbound⟩ := affine_prefix_bound ha (show 0 < δ / 4 by positivity) have hsmall := (tendsto_const_div_loglog (C * weight 0)).eventually (gt_mem_nhds (show (0 : ℝ) < δ / 2 by positivity)) have hsum := tendsto_weight_sum_div_loglog.eventually (gt_mem_nhds (show (1 : ℝ) < 2 by norm_num)) filter_upwards [hsmall, hsum, tendsto_loglog.eventually (eventually_gt_atTop 0)] with N hsmall hsum hpos rw [Real.dist_eq, sub_zero, abs_div, abs_of_pos hpos] have hb := weighted_affine_bound weight a weight_antitone (fun k => (weight_pos k).le) hC hbound N have hd := div_le_div_of_nonneg_right hb hpos.le rw [add_div, mul_div_assoc] at hd have hmul : δ / 4 * ((∑ k ∈ range N, weight k) / Real.log (Real.log N)) < δ / 2 := by nlinarith linarith /-- The regular logarithmic summation method preserves a Cesàro limit. -/ theorem tendsto_weighted_of_cesaro {a : ℕ → ℝ} {c : ℝ} (ha : Tendsto (fun N : ℕ => (∑ k ∈ range N, a k) / N) atTop (𝓝 c)) : Tendsto (fun N : ℕ => (∑ k ∈ range N, weight k * a k) / Real.log (Real.log N)) atTop (𝓝 c) := by have he : Tendsto (fun N : ℕ => (∑ k ∈ range N, (a k - c)) / N) atTop (𝓝 0) := by have hsub : Tendsto (fun N : ℕ => (∑ k ∈ range N, a k) / N - c) atTop (𝓝 0) := by simpa using ha.sub (tendsto_const_nhds : Tendsto (fun _ : ℕ => c) atTop (𝓝 c)) apply hsub.congr' filter_upwards [eventually_gt_atTop 0] with N hN have hNr : (N : ℝ) ≠ 0 := by exact_mod_cast Nat.ne_of_gt hN simp [sum_sub_distrib, sum_const, nsmul_eq_mul, sub_div, hNr, mul_div_cancel_left₀] have hh := (tendsto_weighted_zero he).add (tendsto_weight_sum_div_loglog.const_mul c) convert hh using 1 · ext N simp only [mul_sub, sum_sub_distrib, ← sum_mul, sub_div, mul_div_assoc] ring · simp /-- Cesàro convergence transfers to reciprocal logarithmic weighting. The zero and one terms vanish by total real division; no sign condition on the coefficients is needed. -/ theorem tendsto_reciprocal_log_of_cesaro {a : ℕ → ℝ} {c : ℝ} (ha : Tendsto (fun N : ℕ => (∑ k ∈ range N, a k) / N) atTop (𝓝 c)) : Tendsto (fun N : ℕ => (∑ k ∈ range N, a k / ((k : ℝ) * Real.log k)) / Real.log (Real.log N)) atTop (𝓝 c) := by have h := (tendsto_weighted_of_cesaro ha).sub (tendsto_const_div_loglog (kernel 2 * (a 0 + a 1))) simp only [sub_zero] at h apply h.congr' filter_upwards [eventually_ge_atTop 2] with N hN have heq : (∑ k ∈ range N, weight k * a k) = kernel 2 * (a 0 + a 1) + ∑ k ∈ range N, a k / ((k : ℝ) * Real.log k) := by rw [← sum_range_add_sum_Ico (fun k => weight k * a k) hN, ← sum_range_add_sum_Ico (fun k => a k / ((k : ℝ) * Real.log k)) hN] have htail : (∑ k ∈ Ico 2 N, weight k * a k) = ∑ k ∈ Ico 2 N, a k / ((k : ℝ) * Real.log k) := by apply sum_congr rfl intro k hk rw [weight_eq (mem_Ico.mp hk).1] simp [kernel, div_eq_mul_inv, mul_comm] rw [htail] norm_num [Finset.sum_range_succ, weight, kernel] ring rw [heq, add_div] ring lemma primeWeight_div_kernel (n : ℕ) : PrimeProgressions.primeWeight 1 n / ((n : ℝ) * Real.log n) = if n.Prime ∧ n % 4 = 1 then 1 / (n : ℝ) else 0 := by by_cases hn : n.Prime ∧ n % 4 = 1 · have hn1 : (1 : ℝ) < n := by exact_mod_cast hn.1.one_lt have hn0 : (n : ℝ) ≠ 0 := by linarith have hlog : Real.log (n : ℝ) ≠ 0 := (Real.log_pos hn1).ne' simp only [PrimeProgressions.primeWeight, if_pos hn] field_simp [hn0, hlog] · simp [PrimeProgressions.primeWeight, hn] /-- The split-prime reciprocal asymptotic, including the endpoint in the definition of `splitPrimeReciprocal`, follows from the AP prime-log asymptotic. -/ theorem tendsto_splitPrimeReciprocal : Tendsto (fun N : ℕ => PrimeProgressions.splitPrimeReciprocal N / Real.log (Real.log N)) atTop (𝓝 (1 / 2 : ℝ)) := by let r : ℕ → ℝ := fun n => if n.Prime ∧ n % 4 = 1 then 1 / (n : ℝ) else 0 have hr0 (n : ℕ) : 0 ≤ r n := by dsimp [r] split_ifs <;> positivity have hr1 (n : ℕ) : r n ≤ 1 / (n : ℝ) := by dsimp [r] split_ifs · exact le_rfl · positivity have hmain := tendsto_reciprocal_log_of_cesaro (a := PrimeProgressions.primeWeight 1) (c := (1 / 2 : ℝ)) (by simpa only [PrimeProgressions.theta] using PrimeProgressions.tendsto_theta_one_div) have hupper : Tendsto (fun N : ℕ => (1 / (N : ℝ)) / Real.log (Real.log N)) atTop (𝓝 0) := by have hinv := tendsto_inv_atTop_zero.comp (tendsto_natCast_atTop_atTop : Tendsto (fun N : ℕ => (N : ℝ)) atTop atTop) simpa only [Function.comp_apply, one_div, div_eq_mul_inv, one_mul, mul_zero] using hinv.mul (tendsto_inv_atTop_zero.comp tendsto_loglog) have hend : Tendsto (fun N : ℕ => r N / Real.log (Real.log N)) atTop (𝓝 0) := by apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds hupper · filter_upwards [tendsto_loglog.eventually (eventually_gt_atTop 0)] with N hN exact div_nonneg (hr0 N) hN.le · filter_upwards [tendsto_loglog.eventually (eventually_gt_atTop 0)] with N hN exact div_le_div_of_nonneg_right (hr1 N) hN.le have heq (N : ℕ) : PrimeProgressions.splitPrimeReciprocal N = (∑ k ∈ range N, PrimeProgressions.primeWeight 1 k / ((k : ℝ) * Real.log k)) + r N := by rw [PrimeProgressions.splitPrimeReciprocal, sum_filter, Finset.sum_range_succ] congr 1 exact sum_congr rfl fun k _ => (primeWeight_div_kernel k).symm have hs := hmain.add hend simp only [add_zero] at hs apply hs.congr' filter_upwards [] with N rw [heq, add_div] end DistanceCounts.MertensTransfer end end BodyFile028 -- Source: DistanceCounts/GaussianCutoff.lean section BodyFile029 /-! Real-radius truncation, its actual density center, and its boundary error. -/ noncomputable section namespace DistanceCounts.GaussianCutoff open Filter Finset open scoped Topology Classical /-- The cutoff is taken at every real radius, not only at integral radii. -/ def cutoff (R : ℝ) : ℕ := ⌊R ^ (1 / 10 : ℝ)⌋₊ /-- The inclusive split-prime truncation used by the AP reciprocal sum. -/ def smallPrimes (R : ℝ) : Finset ℕ := (range (cutoff R + 1)).filter (fun p => p.Prime ∧ p % 4 = 1) lemma mem_smallPrimes {R : ℝ} {p : ℕ} (hp : p ∈ smallPrimes R) : p ≤ cutoff R ∧ p.Prime ∧ p % 4 = 1 := by simpa [smallPrimes, Nat.lt_succ_iff] using hp lemma smallPrimes_five_le {R : ℝ} {p : ℕ} (hp : p ∈ smallPrimes R) : 5 ≤ p := GaussianExcess.split_prime_five_le (mem_smallPrimes hp).2.1 (mem_smallPrimes hp).2.2 lemma cutoff_le {R : ℝ} (hR : 0 ≤ R) : (cutoff R : ℝ) ≤ R ^ (1 / 10 : ℝ) := Nat.floor_le (Real.rpow_nonneg hR _) /-- The lower power absorbs the absolute floor error. -/ theorem eventually_cutoff_bounds : ∀ᶠ R : ℝ in atTop, R ^ (1 / 20 : ℝ) ≤ (cutoff R : ℝ) ∧ (cutoff R : ℝ) ≤ R ^ (1 / 10 : ℝ) := by filter_upwards [eventually_ge_atTop (0 : ℝ), (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 20)).eventually (eventually_ge_atTop 2)] with R hR hpow have hsquare : R ^ (1 / 10 : ℝ) = (R ^ (1 / 20 : ℝ)) ^ (2 : ℕ) := by rw [← Real.rpow_mul_natCast hR] norm_num have hfloor : R ^ (1 / 10 : ℝ) - 1 < (cutoff R : ℝ) := Nat.sub_one_lt_floor _ exact ⟨by rw [hsquare] at hfloor; nlinarith, cutoff_le hR⟩ theorem tendsto_cutoff : Tendsto cutoff atTop atTop := by apply tendsto_atTop.mpr intro n filter_upwards [eventually_cutoff_bounds, (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 20)).eventually (eventually_ge_atTop (n : ℝ))] with R hR hn exact_mod_cast hn.trans hR.1 lemma tendsto_loglog : Tendsto (fun R : ℝ => Real.log (Real.log R)) atTop atTop := Real.tendsto_log_atTop.comp Real.tendsto_log_atTop lemma tendsto_cutoff_loglog : Tendsto (fun R : ℝ => Real.log (Real.log (cutoff R : ℝ))) atTop atTop := MertensTransfer.tendsto_loglog.comp tendsto_cutoff /-- Positivity and the associated nonvanishing conditions required by divisions. -/ lemma eventually_positive : ∀ᶠ R : ℝ in atTop, 0 < R ∧ 1 < (cutoff R : ℝ) ∧ 0 < Real.log R ∧ 0 < Real.log (cutoff R : ℝ) ∧ 0 < Real.log (Real.log R) ∧ 0 < Real.log (Real.log (cutoff R : ℝ)) := by filter_upwards [eventually_gt_atTop (1 : ℝ), tendsto_cutoff.eventually (eventually_ge_atTop 2), tendsto_loglog.eventually (eventually_gt_atTop 0), tendsto_cutoff_loglog.eventually (eventually_gt_atTop 0)] with R hR hc hl hlc have hc' : (1 : ℝ) < cutoff R := by exact_mod_cast (show 1 < cutoff R by omega) exact ⟨by linarith, hc', Real.log_pos hR, Real.log_pos hc', hl, hlc⟩ lemma eventually_nonzero : ∀ᶠ R : ℝ in atTop, R ≠ 0 ∧ (cutoff R : ℝ) ≠ 0 ∧ Real.log R ≠ 0 ∧ Real.log (cutoff R : ℝ) ≠ 0 ∧ Real.log (Real.log R) ≠ 0 ∧ Real.log (Real.log (cutoff R : ℝ)) ≠ 0 := by filter_upwards [eventually_positive] with R h exact ⟨h.1.ne', (lt_trans zero_lt_one h.2.1).ne', h.2.2.1.ne', h.2.2.2.1.ne', h.2.2.2.2.1.ne', h.2.2.2.2.2.ne'⟩ lemma loglog_rpow {R a : ℝ} (hR : 1 < R) (ha : 0 < a) : Real.log (Real.log (R ^ a)) = Real.log (Real.log R) + Real.log a := by rw [Real.log_rpow (by linarith), Real.log_mul ha.ne' (Real.log_pos hR).ne'] ring /-- Two explicit translates of log-log squeeze the floor cutoff. -/ lemma eventually_loglog_bounds : ∀ᶠ R : ℝ in atTop, Real.log (Real.log R) + Real.log (1 / 20 : ℝ) ≤ Real.log (Real.log (cutoff R : ℝ)) ∧ Real.log (Real.log (cutoff R : ℝ)) ≤ Real.log (Real.log R) + Real.log (1 / 10 : ℝ) := by filter_upwards [eventually_cutoff_bounds, eventually_positive, eventually_gt_atTop (1 : ℝ)] with R hb hp hR constructor · rw [← loglog_rpow hR (by norm_num : (0 : ℝ) < 1 / 20)] apply Real.log_le_log · exact Real.log_pos (Real.one_lt_rpow hR (by norm_num)) · exact Real.log_le_log (Real.rpow_pos_of_pos hp.1 _) hb.1 · rw [← loglog_rpow hR (by norm_num : (0 : ℝ) < 1 / 10)] apply Real.log_le_log hp.2.2.2.1 exact Real.log_le_log (lt_trans zero_lt_one hp.2.1) hb.2 lemma tendsto_const_div_loglog (C : ℝ) : Tendsto (fun R : ℝ => C / Real.log (Real.log R)) atTop (𝓝 0) := by simpa [div_eq_mul_inv] using (tendsto_const_nhds.mul (tendsto_inv_atTop_zero.comp tendsto_loglog) : Tendsto (fun R : ℝ => C * (Real.log (Real.log R))⁻¹) atTop (𝓝 (C * 0))) theorem tendsto_loglog_cutoff_div_loglog : Tendsto (fun R : ℝ => Real.log (Real.log (cutoff R : ℝ)) / Real.log (Real.log R)) atTop (𝓝 1) := by have hlo : Tendsto (fun R : ℝ => 1 + Real.log (1 / 20 : ℝ) / Real.log (Real.log R)) atTop (𝓝 1) := by simpa using tendsto_const_nhds.add (tendsto_const_div_loglog (Real.log (1 / 20 : ℝ))) have hhi : Tendsto (fun R : ℝ => 1 + Real.log (1 / 10 : ℝ) / Real.log (Real.log R)) atTop (𝓝 1) := by simpa using tendsto_const_nhds.add (tendsto_const_div_loglog (Real.log (1 / 10 : ℝ))) apply tendsto_of_tendsto_of_tendsto_of_le_of_le' hlo hhi · filter_upwards [eventually_loglog_bounds, eventually_positive] with R hb hp apply (le_div_iff₀ hp.2.2.2.2.1).mpr rw [add_mul, one_mul, div_mul_cancel₀ _ hp.2.2.2.2.1.ne'] exact hb.1 · filter_upwards [eventually_loglog_bounds, eventually_positive] with R hb hp apply (div_le_iff₀ hp.2.2.2.2.1).mpr rw [add_mul, one_mul, div_mul_cancel₀ _ hp.2.2.2.2.1.ne'] exact hb.2 lemma center_eq (R : ℝ) : GaussianMoments.center (smallPrimes R) = 2 * PrimeProgressions.splitPrimeReciprocal (cutoff R) - ∑ p ∈ smallPrimes R, 1 / (p : ℝ) ^ 2 := by simp only [GaussianMoments.center, GaussianDivisibility.splitDensity, sum_sub_distrib, PrimeProgressions.splitPrimeReciprocal, ← mul_sum] congr 1 unfold smallPrimes rw [mul_sum] exact sum_congr rfl fun p _ => by ring lemma reciprocal_square_sum_bounds (R : ℝ) : 0 ≤ (∑ p ∈ smallPrimes R, 1 / (p : ℝ) ^ 2) ∧ (∑ p ∈ smallPrimes R, 1 / (p : ℝ) ^ 2) ≤ 2 := ⟨sum_nonneg (fun p _ => by positivity), GaussianExcess.reciprocal_square_sum_le _ (fun _ hp => smallPrimes_five_le hp)⟩ lemma tendsto_reciprocal_square_sum_div_loglog : Tendsto (fun R : ℝ => (∑ p ∈ smallPrimes R, 1 / (p : ℝ) ^ 2) / Real.log (Real.log R)) atTop (𝓝 0) := by apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds (tendsto_const_div_loglog 2) · filter_upwards [eventually_positive] with R hR exact div_nonneg (reciprocal_square_sum_bounds R).1 hR.2.2.2.2.1.le · filter_upwards [eventually_positive] with R hR exact div_le_div_of_nonneg_right (reciprocal_square_sum_bounds R).2 hR.2.2.2.2.1.le /-- Composition uses the actual inclusive AP Mertens sum. -/ theorem tendsto_splitPrimeReciprocal_div_loglog : Tendsto (fun R : ℝ => PrimeProgressions.splitPrimeReciprocal (cutoff R) / Real.log (Real.log R)) atTop (𝓝 (1 / 2 : ℝ)) := by have h := (MertensTransfer.tendsto_splitPrimeReciprocal.comp tendsto_cutoff).mul tendsto_loglog_cutoff_div_loglog simp only [mul_one] at h apply h.congr' filter_upwards [eventually_nonzero] with R hR dsimp only [Function.comp_apply] field_simp [hR.2.2.2.2.2, hR.2.2.2.2.1] theorem tendsto_center_div_loglog : Tendsto (fun R : ℝ => GaussianMoments.center (smallPrimes R) / Real.log (Real.log R)) atTop (𝓝 1) := by have h := (tendsto_splitPrimeReciprocal_div_loglog.const_mul 2).sub tendsto_reciprocal_square_sum_div_loglog norm_num only at h convert h using 1 ext R rw [center_eq, sub_div, mul_div_assoc] lemma card_smallPrimes_le (R : ℝ) : (smallPrimes R).card ≤ cutoff R + 1 := by exact (card_filter_le _ _).trans_eq (card_range _) lemma eventually_card_smallPrimes_le : ∀ᶠ R : ℝ in atTop, ((smallPrimes R).card : ℝ) ≤ (cutoff R : ℝ) + 1 ∧ (cutoff R : ℝ) + 1 ≤ R ^ (1 / 10 : ℝ) + 1 := by filter_upwards [eventually_ge_atTop (0 : ℝ)] with R hR exact ⟨by exact_mod_cast card_smallPrimes_le R, by linarith [cutoff_le hR]⟩ /-- A power majorant for the actual finite-set boundary term. -/ lemma eventually_boundary_le : ∀ᶠ R : ℝ in atTop, 0 ≤ ((R + 1) * ((smallPrimes R).card : ℝ) ^ 2) / R ^ 2 ∧ ((R + 1) * ((smallPrimes R).card : ℝ) ^ 2) / R ^ 2 ≤ 8 * R ^ (-(4 / 5 : ℝ)) := by filter_upwards [eventually_ge_atTop (1 : ℝ), eventually_card_smallPrimes_le] with R hR hc have hR0 : 0 < R := by linarith have hx : 1 ≤ R ^ (1 / 10 : ℝ) := Real.one_le_rpow hR (by norm_num) have hc' : ((smallPrimes R).card : ℝ) ≤ 2 * R ^ (1 / 10 : ℝ) := by linarith [hc.1.trans hc.2] have hsquare : (R ^ (1 / 10 : ℝ)) ^ (2 : ℕ) = R ^ (1 / 5 : ℝ) := by rw [← Real.rpow_mul_natCast hR0.le] norm_num have hcsquare : ((smallPrimes R).card : ℝ) ^ 2 ≤ 4 * R ^ (1 / 5 : ℝ) := by have hn : 0 ≤ ((smallPrimes R).card : ℝ) := Nat.cast_nonneg _ nlinarith [mul_self_le_mul_self hn hc'] have hnum : (R + 1) * ((smallPrimes R).card : ℝ) ^ 2 ≤ 8 * R * R ^ (1 / 5 : ℝ) := by calc _ ≤ (2 * R) * (4 * R ^ (1 / 5 : ℝ)) := mul_le_mul (by linarith) hcsquare (sq_nonneg _) (by positivity) _ = _ := by ring have heq : (8 * R * R ^ (1 / 5 : ℝ)) / R ^ 2 = 8 * R ^ (-(4 / 5 : ℝ)) := by have hrpow : R ^ (-(4 / 5 : ℝ)) = R ^ (1 / 5 : ℝ) / R := by convert Real.rpow_sub hR0 (1 / 5) 1 using 1 <;> norm_num rw [hrpow] field_simp [hR0.ne'] <;> ring exact ⟨by positivity, (div_le_div_of_nonneg_right hnum (sq_nonneg R)).trans_eq heq⟩ theorem tendsto_boundary_error : Tendsto (fun R : ℝ => ((R + 1) * ((smallPrimes R).card : ℝ) ^ 2) / R ^ 2) atTop (𝓝 0) := by have hpow : Tendsto (fun R : ℝ => 8 * R ^ (-(4 / 5 : ℝ))) atTop (𝓝 0) := by simpa using (tendsto_rpow_neg_atTop (by norm_num : (0 : ℝ) < 4 / 5)).const_mul 8 exact tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds hpow (eventually_boundary_le.mono fun _ h => h.1) (eventually_boundary_le.mono fun _ h => h.2) end DistanceCounts.GaussianCutoff end end BodyFile029 -- Source: DistanceCounts/RepresentationFormula.lean section BodyFile030 /-! Exact overlaps and prime-step recurrences for the genuine finite norm circles. -/ noncomputable section namespace DistanceCounts /-- The common elements of the two split-prime images have a unique common rational-prime factor. The norm equation records divisibility without division, so this statement also treats the zero circle correctly. -/ lemma mem_normCircle_split_inter (p n : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) {z : GaussianInt} (hz : z.norm.natAbs = p) (w : GaussianInt) : w ∈ (normCircle n).image (fun v => z * v) ∩ (normCircle n).image (fun v => star z * v) ↔ ∃ c : GaussianInt, p * c.norm.natAbs = n ∧ (p : GaussianInt) * c = w := by classical have hzp := gaussian_prime_of_prime_norm hp hz have hzc : (star z).norm.natAbs = p := by simpa using hz have hcp := gaussian_prime_of_prime_norm hp hzc have hnot : ¬star z ∣ z := by intro hd exact not_associated_conj_of_split_prime_norm hp hp4 hz (hcp.associated_of_dvd hzp hd).symm have hzn : z.norm = (p : ℤ) := (mem_normCircle_iff_norm _ _).mp ((mem_normCircle _ _).mpr hz) have hpcast : (p : GaussianInt) = z * star z := by rw [← Zsqrtd.norm_eq_mul_conj, hzn] simp constructor · intro hw obtain ⟨ha, hb⟩ := Finset.mem_inter.mp hw obtain ⟨a, ha, haw⟩ := Finset.mem_image.mp ha obtain ⟨b, _, hbw⟩ := Finset.mem_image.mp hb have hd : star z ∣ z * a := ⟨b, haw.trans hbw.symm⟩ have hda : star z ∣ a := (hcp.dvd_or_dvd hd).resolve_left hnot obtain ⟨c, rfl⟩ := hda refine ⟨c, ?_, ?_⟩ · simpa [Zsqrtd.norm_mul, Int.natAbs_mul, hzc, hz] using (mem_normCircle _ _).mp ha · simpa only [hpcast, mul_assoc] using haw · rintro ⟨c, hc, rfl⟩ apply Finset.mem_inter.mpr constructor · refine Finset.mem_image.mpr ⟨star z * c, ?_, ?_⟩ · apply (mem_normCircle _ _).mpr simpa [Zsqrtd.norm_mul, Int.natAbs_mul, hzc, hz] using hc · rw [hpcast, mul_assoc] · refine Finset.mem_image.mpr ⟨z * c, ?_, ?_⟩ · apply (mem_normCircle _ _).mpr simpa [Zsqrtd.norm_mul, Int.natAbs_mul, hz] using hc · rw [hpcast] ring /-- When the residual norm is divisible by the split prime, the overlap is exactly the rational-prime multiple of the quotient circle. -/ theorem normCircle_split_inter_of_dvd (p n : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) {z : GaussianInt} (hz : z.norm.natAbs = p) (hd : p ∣ n) : (normCircle n).image (fun v => z * v) ∩ (normCircle n).image (fun v => star z * v) = (normCircle (n / p)).image (fun c => (p : GaussianInt) * c) := by classical ext w rw [mem_normCircle_split_inter p n hp hp4 hz] constructor · rintro ⟨c, hc, hcw⟩ refine Finset.mem_image.mpr ⟨c, (mem_normCircle _ _).mpr ?_, hcw⟩ apply mul_left_cancel₀ hp.ne_zero exact hc.trans (Nat.mul_div_cancel' hd).symm · intro hw obtain ⟨c, hc, hcw⟩ := Finset.mem_image.mp hw refine ⟨c, ?_, hcw⟩ rw [(mem_normCircle _ _).mp hc, Nat.mul_div_cancel' hd] /-- If the split prime does not divide the residual norm, the images are disjoint. This excludes overlap by actual Gaussian prime cancellation. -/ theorem normCircle_split_inter_of_not_dvd (p n : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) {z : GaussianInt} (hz : z.norm.natAbs = p) (hd : ¬p ∣ n) : (normCircle n).image (fun v => z * v) ∩ (normCircle n).image (fun v => star z * v) = ∅ := by classical apply Finset.eq_empty_iff_forall_notMem.mpr intro w hw obtain ⟨c, hc, _⟩ := (mem_normCircle_split_inter p n hp hp4 hz w).mp hw exact hd ⟨c.norm.natAbs, hc.symm⟩ /-- Inclusion-exclusion gives the exact additive recurrence, including at zero. There is no subtraction of natural cardinalities and no multiplicativity input. -/ theorem normCircle_split_mul_card (p n : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) : (normCircle (p * n)).card + (if p ∣ n then (normCircle (n / p)).card else 0) = 2 * (normCircle n).card := by classical obtain ⟨a, b, hab⟩ := @Nat.Prime.sq_add_sq p ⟨hp⟩ (by omega) obtain ⟨z, hzmem⟩ := (normCircle_nonempty_iff_sum_two_squares p).mpr ⟨a, b, hab.symm⟩ have hz := (mem_normCircle _ _).mp hzmem have hz0 := ne_zero_of_mem_normCircle hp.ne_zero hzmem have hzc0 : star z ≠ 0 := by simpa using hz0 have hp0 : (p : GaussianInt) ≠ 0 := by exact_mod_cast hp.ne_zero have hcard := Finset.card_union_add_card_inter ((normCircle n).image (fun v => z * v)) ((normCircle n).image (fun v => star z * v)) rw [← normCircle_prime_mul p n hp hz, Finset.card_image_of_injective _ (fun _ _ h => mul_left_cancel₀ hz0 h), Finset.card_image_of_injective _ (fun _ _ h => mul_left_cancel₀ hzc0 h)] at hcard by_cases hd : p ∣ n · rw [normCircle_split_inter_of_dvd p n hp hp4 hz hd, Finset.card_image_of_injective _ (fun _ _ h => mul_left_cancel₀ hp0 h)] at hcard simpa only [if_pos hd, two_mul] using hcard · rw [normCircle_split_inter_of_not_dvd p n hp hp4 hz hd, Finset.card_empty] at hcard simpa only [if_neg hd, two_mul] using hcard /-- The unramified first step doubles the number of representations. -/ theorem normCircle_split_mul_card_of_not_dvd (p n : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) (hd : ¬p ∣ n) : (normCircle (p * n)).card = 2 * (normCircle n).card := by simpa only [if_neg hd, add_zero] using normCircle_split_mul_card p n hp hp4 /-- The second-order recurrence solves to a linear factor along every split prime-power direction, with an arbitrary coprime residual norm. -/ theorem normCircle_split_pow_mul_card (p k n : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) (hd : ¬p ∣ n) : (normCircle (p ^ k * n)).card = (k + 1) * (normCircle n).card := by induction k using Nat.twoStepInduction with | zero => simp | one => simpa only [pow_one] using normCircle_split_mul_card_of_not_dvd p n hp hp4 hd | more k ih₀ ih₁ => have hd' : p ∣ p ^ (k + 1) * n := by rw [pow_succ', mul_assoc] exact dvd_mul_right _ _ have hdiv : p ^ (k + 1) * n / p = p ^ k * n := by rw [pow_succ', mul_assoc, Nat.mul_div_cancel_left _ hp.pos] have hstep := normCircle_split_mul_card p (p ^ (k + 1) * n) hp hp4 rw [if_pos hd', hdiv, ih₀, ih₁] at hstep have hpow : p * (p ^ (k + 1) * n) = p ^ (k + 2) * n := by simpa only [mul_assoc] using congrArg (fun a : ℕ => a * n) (pow_succ' p (k + 1)).symm rw [hpow] at hstep nlinarith /-- In particular, a split prime power has exactly four times its exponent plus one representations, including exponent zero. -/ theorem normCircle_split_pow_card (p k : ℕ) (hp : p.Prime) (hp4 : p % 4 = 1) : (normCircle (p ^ k)).card = 4 * (k + 1) := by have hd : ¬p ∣ 1 := by intro h exact hp.ne_one (Nat.dvd_one.mp h) simpa [normCircle_one_card, mul_comm] using normCircle_split_pow_mul_card p k 1 hp hp4 hd /-- Multiplication by `1+i` parametrizes the entire doubled norm circle. The conjugate image is the same image, because `1-i = (1+i)(-i)`. -/ theorem normCircle_two_mul (n : ℕ) : normCircle (2 * n) = (normCircle n).image (fun v => (⟨1, 1⟩ : GaussianInt) * v) := by classical let z : GaussianInt := ⟨1, 1⟩ let u : GaussianInt := ⟨0, -1⟩ have hz : z.norm.natAbs = 2 := by norm_num [z, Zsqrtd.norm] have hu : u.norm.natAbs = 1 := by norm_num [u, Zsqrtd.norm] have hconj : star z = z * u := by ext <;> norm_num [z, u] change normCircle (2 * n) = (normCircle n).image (fun v => z * v) rw [normCircle_prime_mul 2 n Nat.prime_two hz] apply Finset.union_eq_left.mpr intro w hw obtain ⟨v, hv, rfl⟩ := Finset.mem_image.mp hw refine Finset.mem_image.mpr ⟨u * v, ?_, ?_⟩ · apply (mem_normCircle _ _).mpr simp [Zsqrtd.norm_mul, Int.natAbs_mul, hu, (mem_normCircle _ _).mp hv] · rw [hconj, mul_assoc] /-- The ramified prime does not change the representation count. -/ theorem normCircle_two_mul_card (n : ℕ) : (normCircle (2 * n)).card = (normCircle n).card := by classical rw [normCircle_two_mul] apply Finset.card_image_of_injective have hz0 : (⟨1, 1⟩ : GaussianInt) ≠ 0 := by intro h have := congrArg Zsqrtd.re h norm_num at this exact fun _ _ h => mul_left_cancel₀ hz0 h /-- Removing any power of the ramified prime is exact, not merely an estimate. -/ theorem normCircle_two_pow_mul_card (k n : ℕ) : (normCircle (2 ^ k * n)).card = (normCircle n).card := by induction k with | zero => simp | succ k ih => rw [pow_succ', mul_assoc, normCircle_two_mul_card, ih] /-- One uncancelled inert prime forces an empty circle when the residual norm is coprime to that prime. -/ theorem normCircle_inert_mul_of_not_dvd (p n : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) (hd : ¬p ∣ n) : normCircle (p * n) = ∅ := by classical apply Finset.eq_empty_iff_forall_notMem.mpr intro z hz have hnorm := (mem_normCircle _ _).mp hz have hpd : p ∣ z.norm.natAbs := by rw [hnorm] exact dvd_mul_right _ _ obtain ⟨w, rfl⟩ := (GaussianNorm.inert_dvd_natNorm_iff p hp hp3 z).mp hpd have he : p * (p * w.norm.natAbs) = p * n := by simpa [Zsqrtd.norm_mul, Zsqrtd.norm_natCast, Int.natAbs_mul, mul_assoc] using hnorm exact hd ⟨w.norm.natAbs, (mul_left_cancel₀ hp.ne_zero he).symm⟩ /-- Repeated inert-square removal handles every even inert exponent. -/ theorem normCircle_inert_even_pow_mul_card (p k n : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) : (normCircle (p ^ (2 * k) * n)).card = (normCircle n).card := by induction k with | zero => simp | succ k ih => have he : p ^ (2 * (k + 1)) * n = p * p * (p ^ (2 * k) * n) := by rw [show 2 * (k + 1) = 2 + 2 * k by omega, pow_add, pow_two] ring rw [he, normCircle_inert_square_card p _ hp hp3, ih] /-- An odd inert exponent cannot contribute representations when the remaining factor is coprime to that inert prime. -/ theorem normCircle_inert_odd_pow_mul_card (p k n : ℕ) (hp : p.Prime) (hp3 : p % 4 = 3) (hd : ¬p ∣ n) : (normCircle (p ^ (2 * k + 1) * n)).card = 0 := by have he : p ^ (2 * k + 1) * n = p ^ (2 * k) * (p * n) := by rw [pow_succ, mul_assoc] rw [he, normCircle_inert_even_pow_mul_card p k (p * n) hp hp3, normCircle_inert_mul_of_not_dvd p n hp hp3 hd, Finset.card_empty] /-- Independent prime-power removals give the representation count of a genuine finite product. No multiplicativity of representation counts is assumed. -/ theorem normCircle_prod_primePowers_card (S : Finset ℕ) (k : ℕ → ℕ) (hprime : ∀ p ∈ S, p.Prime) (heven : ∀ p ∈ S, p % 4 = 3 → Even (k p)) : (normCircle (∏ p ∈ S, p ^ k p)).card = 4 * ∏ p ∈ S, if p % 4 = 1 then k p + 1 else 1 := by classical revert hprime heven induction S using Finset.induction_on with | empty => intro _ _ simp [normCircle_one_card] | @insert p S hpS ih => intro hprime heven have hpp := hprime p (Finset.mem_insert_self p S) have hprimeS : ∀ q ∈ S, q.Prime := fun q hq => hprime q (Finset.mem_insert_of_mem hq) have hevenS : ∀ q ∈ S, q % 4 = 3 → Even (k q) := fun q hq => heven q (Finset.mem_insert_of_mem hq) have ih' := ih hprimeS hevenS rw [Finset.prod_insert hpS, Finset.prod_insert hpS] rcases hpp.eq_two_or_odd with htwo | hodd · subst p rw [normCircle_two_pow_mul_card, ih'] norm_num · have hp4 : p % 4 = 1 ∨ p % 4 = 3 := by omega rcases hp4 with hp1 | hp3 · have hcop : Nat.Coprime p (∏ q ∈ S, q ^ k q) := by apply Nat.Coprime.prod_right intro q hq apply Nat.Coprime.pow_right apply (Nat.coprime_primes hpp (hprimeS q hq)).mpr rintro rfl exact hpS hq have hd := hpp.coprime_iff_not_dvd.mp hcop rw [normCircle_split_pow_mul_card p (k p) _ hpp hp1 hd, ih'] simp only [if_pos hp1] ring · obtain ⟨r, hr⟩ := heven p (Finset.mem_insert_self p S) hp3 have hk : k p = 2 * r := by omega rw [hk, normCircle_inert_even_pow_mul_card p r _ hpp hp3, ih'] norm_num [hp3] /-- The classical product formula for the actual Gaussian norm circle. The positive-norm and representability hypotheses account for every inert factor. -/ theorem normCircle_card_factorization (n : ℕ) (hn : n ≠ 0) (hrep : (normCircle n).Nonempty) : (normCircle n).card = 4 * ∏ p ∈ n.primeFactors.filter (fun p => p % 4 = 1), (n.factorization p + 1) := by classical have heven : ∀ p ∈ n.primeFactors, p % 4 = 3 → Even (n.factorization p) := by intro p hp hp3 rw [Nat.factorization_def n (Nat.prime_of_mem_primeFactors hp)] exact (normCircle_nonempty_iff n).mp hrep p hp hp3 calc (normCircle n).card = (normCircle (∏ p ∈ n.primeFactors, p ^ n.factorization p)).card := congrArg (fun m => (normCircle m).card) (Nat.prod_primeFactors_pow_factorization hn) _ = 4 * ∏ p ∈ n.primeFactors, if p % 4 = 1 then n.factorization p + 1 else 1 := normCircle_prod_primePowers_card n.primeFactors n.factorization (fun p hp => Nat.prime_of_mem_primeFactors hp) heven _ = _ := by simp only [Finset.prod_filter] end DistanceCounts end end BodyFile030 -- Source: DistanceCounts/RepresentationLog.lean section BodyFile031 noncomputable section namespace DistanceCounts.RepresentationLog /-- The exact representation product gives a logarithmic sandwich. The error is precisely the excess of split-prime exponents over their first occurrence. -/ theorem normCircle_log_bounds (n : ℕ) (hn : n ≠ 0) (hrep : (normCircle n).Nonempty) : let S := n.primeFactors.filter (fun p => p % 4 = 1) Real.log 4 + Real.log 2 * (S.card : ℝ) ≤ Real.log ((normCircle n).card : ℝ) ∧ Real.log ((normCircle n).card : ℝ) ≤ Real.log 4 + Real.log 2 * ((S.card : ℝ) + ((∑ p ∈ S, (n.factorization p - 1) : ℕ) : ℝ)) := by classical dsimp only let S := n.primeFactors.filter (fun p => p % 4 = 1) change Real.log 4 + Real.log 2 * (S.card : ℝ) ≤ Real.log ((normCircle n).card : ℝ) ∧ Real.log ((normCircle n).card : ℝ) ≤ Real.log 4 + Real.log 2 * ((S.card : ℝ) + ((∑ p ∈ S, (n.factorization p - 1) : ℕ) : ℝ)) have hpos : ∀ p ∈ S, 0 < n.factorization p := by intro p hp have hp' : p ∈ n.primeFactors := (Finset.mem_filter.mp hp).1 exact (Nat.prime_of_mem_primeFactors hp').factorization_pos_of_dvd hn (Nat.dvd_of_mem_primeFactors hp') have hsum : (∑ p ∈ S, n.factorization p) = S.card + ∑ p ∈ S, (n.factorization p - 1) := by calc (∑ p ∈ S, n.factorization p) = ∑ p ∈ S, (1 + (n.factorization p - 1)) := by apply Finset.sum_congr rfl intro p hp have := hpos p hp omega _ = _ := by simp [Finset.sum_add_distrib] have hlop : 2 ^ S.card ≤ ∏ p ∈ S, (n.factorization p + 1) := by calc 2 ^ S.card = ∏ _p ∈ S, (2 : ℕ) := (Finset.prod_const 2).symm _ ≤ _ := Finset.prod_le_prod' fun p hp => by have := hpos p hp omega have hhip : (∏ p ∈ S, (n.factorization p + 1)) ≤ 2 ^ (S.card + ∑ p ∈ S, (n.factorization p - 1)) := by calc (∏ p ∈ S, (n.factorization p + 1)) ≤ ∏ p ∈ S, 2 ^ n.factorization p := Finset.prod_le_prod' fun p _ => (show n.factorization p < 2 ^ n.factorization p from Nat.lt_two_pow_self).succ_le _ = _ := by rw [Finset.prod_pow_eq_pow_sum, hsum] have hformula : (normCircle n).card = 4 * ∏ p ∈ S, (n.factorization p + 1) := normCircle_card_factorization n hn hrep have hloNat : 4 * 2 ^ S.card ≤ (normCircle n).card := by rw [hformula] exact Nat.mul_le_mul_left 4 hlop have hhiNat : (normCircle n).card ≤ 4 * 2 ^ (S.card + ∑ p ∈ S, (n.factorization p - 1)) := by rw [hformula] exact Nat.mul_le_mul_left 4 hhip have hlo : Real.log ((4 : ℝ) * 2 ^ S.card) ≤ Real.log ((normCircle n).card : ℝ) := Real.log_le_log (by positivity) (by exact_mod_cast hloNat) have hhi : Real.log ((normCircle n).card : ℝ) ≤ Real.log ((4 : ℝ) * 2 ^ (S.card + ∑ p ∈ S, (n.factorization p - 1))) := Real.log_le_log (by exact_mod_cast Finset.card_pos.mpr hrep) (by exact_mod_cast hhiNat) rw [Real.log_mul (by norm_num) (by positivity), Real.log_pow] at hlo hhi constructor · simpa only [mul_comm] using hlo · simpa only [Nat.cast_add, mul_comm] using hhi /-- Every nonzero Gaussian integer supplies both hypotheses of the pointwise representation estimate at its actual natural-valued norm. -/ theorem normCircle_log_bounds_natNorm (z : GaussianInt) (hz : z ≠ 0) : let n := z.norm.natAbs let S := n.primeFactors.filter (fun p => p % 4 = 1) Real.log 4 + Real.log 2 * (S.card : ℝ) ≤ Real.log ((normCircle n).card : ℝ) ∧ Real.log ((normCircle n).card : ℝ) ≤ Real.log 4 + Real.log 2 * ((S.card : ℝ) + ((∑ p ∈ S, (n.factorization p - 1) : ℕ) : ℝ)) := by have hn : z.norm.natAbs ≠ 0 := by simpa only [Ne, Int.natAbs_eq_zero, GaussianInt.norm_eq_zero] using hz exact normCircle_log_bounds z.norm.natAbs hn ⟨z, (mem_normCircle _ _).mpr rfl⟩ /-- Distinct prime divisors above the explicit cutoff occupy at most forty places when the integer has size at most the square of the radius. -/ theorem large_primeFactors_card_le (R : ℝ) (hR : 1 < R) (n M : ℕ) (hn : n ≠ 0) (hnR : (n : ℝ) ≤ R ^ (2 : ℕ)) (hM : R ^ (1 / 20 : ℝ) ≤ (M : ℝ)) : (n.primeFactors.filter (fun p => M < p)).card ≤ 40 := by classical let T := n.primeFactors.filter (fun p => M < p) have hT : T ⊆ n.primeFactors := Finset.filter_subset _ _ have hprod_dvd : (∏ p ∈ T, p) ∣ n := (Finset.prod_dvd_prod_of_subset T n.primeFactors id hT).trans (Nat.prod_primeFactors_dvd n) have hprod_le : (∏ p ∈ T, p) ≤ n := Nat.le_of_dvd (Nat.pos_of_ne_zero hn) hprod_dvd have hRpos : 0 < R := lt_trans zero_lt_one hR have hrootpos : 0 < R ^ (1 / 20 : ℝ) := Real.rpow_pos_of_pos hRpos _ have hroot_le : ∀ p ∈ T, R ^ (1 / 20 : ℝ) ≤ (p : ℝ) := by intro p hp have hMp : M < p := (Finset.mem_filter.mp hp).2 exact hM.trans (by exact_mod_cast hMp.le) have hpow_le : (R ^ (1 / 20 : ℝ)) ^ T.card ≤ R ^ (2 : ℕ) := by calc (R ^ (1 / 20 : ℝ)) ^ T.card = ∏ _p ∈ T, R ^ (1 / 20 : ℝ) := (Finset.prod_const _).symm _ ≤ ∏ p ∈ T, (p : ℝ) := Finset.prod_le_prod (fun _ _ => hrootpos.le) hroot_le _ ≤ (n : ℝ) := by have hcast : ((∏ p ∈ T, p : ℕ) : ℝ) ≤ n := by exact_mod_cast hprod_le simpa only [Nat.cast_prod] using hcast _ ≤ R ^ (2 : ℕ) := hnR have hlog := Real.log_le_log (pow_pos hrootpos T.card) hpow_le rw [Real.log_pow, Real.log_pow, Real.log_rpow hRpos] at hlog have hlogR : 0 < Real.log R := Real.log_pos hR have hcard : (T.card : ℝ) ≤ 40 := by nlinarith exact_mod_cast hcard /-- Restricting the omitted prime divisors to the split primes preserves the same deterministic bound; no distribution hypothesis is needed. -/ theorem large_splitPrimeFactors_card_le (R : ℝ) (hR : 1 < R) (n M : ℕ) (hn : n ≠ 0) (hnR : (n : ℝ) ≤ R ^ (2 : ℕ)) (hM : R ^ (1 / 20 : ℝ) ≤ (M : ℝ)) : ((n.primeFactors.filter (fun p => p % 4 = 1)).filter (fun p => M < p)).card ≤ 40 := by classical apply le_trans (Finset.card_le_card ?_) (large_primeFactors_card_le R hR n M hn hnR hM) intro p hp obtain ⟨hpS, hpM⟩ := Finset.mem_filter.mp hp exact Finset.mem_filter.mpr ⟨(Finset.mem_filter.mp hpS).1, hpM⟩ end DistanceCounts.RepresentationLog end end BodyFile031 -- Source: DistanceCounts/GaussianNormalOrder.lean section BodyFile032 /-! Finite comparisons for point-weighted Gaussian representation normal order. -/ noncomputable section namespace DistanceCounts.GaussianNormalOrder open Finset Filter GaussianMoments GaussianCutoff open scoped Classical Topology /-- All split primes that can divide the norm of a vector in the radius-R population. -/ def allPrimes (R : ℝ) : Finset ℕ := (range (⌊R ^ 2⌋₊ + 1)).filter (fun p => p.Prime ∧ p % 4 = 1) /-- The actual split prime divisors of a vector's norm. -/ def normPrimes (z : GaussianInt) : Finset ℕ := z.norm.natAbs.primeFactors.filter (fun p => p % 4 = 1) lemma allPrimes_spec (R : ℝ) : ∀ p ∈ allPrimes R, p.Prime ∧ p % 4 = 1 := by intro p hp exact (mem_filter.mp hp).2 lemma natNorm_ne_zero {z : GaussianInt} (hz : z ≠ 0) : z.norm.natAbs ≠ 0 := by simpa only [Ne, Int.natAbs_eq_zero, GaussianInt.norm_eq_zero] using hz lemma normPrimes_subset_all {R : ℝ} {z : GaussianInt} (hz : z ∈ GaussianMass.representatives (R ^ 2)) : normPrimes z ⊆ allPrimes R := by obtain ⟨hz0, hnR⟩ := (GaussianMass.mem_representatives (sq_nonneg R) z).mp hz have hn0 := natNorm_ne_zero hz0 have hn : z.norm.natAbs ≤ ⌊R ^ 2⌋₊ := (Nat.le_floor_iff (sq_nonneg R)).mpr hnR intro p hp obtain ⟨hpS, hp4⟩ := mem_filter.mp hp have hprime := Nat.prime_of_mem_primeFactors hpS have hpdiv := Nat.dvd_of_mem_primeFactors hpS have hpn := Nat.le_of_dvd (Nat.pos_of_ne_zero hn0) hpdiv exact mem_filter.mpr ⟨mem_range.mpr (by omega), hprime, hp4⟩ lemma omega_eq_small_normPrimes (R : ℝ) {z : GaussianInt} (hz : z ≠ 0) : splitOmega (smallPrimes R) z = ((normPrimes z).filter (fun p => p ≤ cutoff R)).card := by have hn0 := natNorm_ne_zero hz unfold splitOmega congr 1 ext p simp only [smallPrimes, normPrimes, mem_filter, mem_range, Nat.lt_succ_iff, Nat.mem_primeFactors] tauto lemma normPrimes_card_bounds {R : ℝ} (hR : 1 < R) (hM : R ^ (1 / 20 : ℝ) ≤ (cutoff R : ℝ)) {z : GaussianInt} (hz : z ∈ GaussianMass.representatives (R ^ 2)) : splitOmega (smallPrimes R) z ≤ (normPrimes z).card ∧ (normPrimes z).card ≤ splitOmega (smallPrimes R) z + 40 := by obtain ⟨hz0, hnR⟩ := (GaussianMass.mem_representatives (sq_nonneg R) z).mp hz have hω := omega_eq_small_normPrimes R hz0 have hpart : ((normPrimes z).filter (fun p => p ≤ cutoff R)).card + ((normPrimes z).filter (fun p => cutoff R < p)).card = (normPrimes z).card := by simpa only [not_le] using (card_filter_add_card_filter_not (s := normPrimes z) (fun p => p ≤ cutoff R)) have hlarge : ((normPrimes z).filter (fun p => cutoff R < p)).card ≤ 40 := by simpa only [normPrimes, Finset.filter_filter] using RepresentationLog.large_splitPrimeFactors_card_le R hR z.norm.natAbs (cutoff R) (natNorm_ne_zero hz0) hnR hM omega /-- The truncation loses at most forty distinct primes; all multiplicity loss is dominated by the actual full excess statistic on the same population. -/ theorem logarithm_pointwise_error {R : ℝ} (hR : 1 < R) (hM : R ^ (1 / 20 : ℝ) ≤ (cutoff R : ℝ)) {z : GaussianInt} (hz : z ∈ GaussianMass.representatives (R ^ 2)) : |Real.log ((normCircle z.norm.natAbs).card : ℝ) - Real.log 2 * (splitOmega (smallPrimes R) z : ℝ)| ≤ Real.log 4 + 40 * Real.log 2 + Real.log 2 * (GaussianExcess.excess (allPrimes R) z : ℝ) := by have hz0 := ((GaussianMass.mem_representatives (sq_nonneg R) z).mp hz).1 have hcounts := normPrimes_card_bounds hR hM hz have hlog := RepresentationLog.normCircle_log_bounds_natNorm z hz0 change Real.log 4 + Real.log 2 * ((normPrimes z).card : ℝ) ≤ Real.log ((normCircle z.norm.natAbs).card : ℝ) ∧ Real.log ((normCircle z.norm.natAbs).card : ℝ) ≤ Real.log 4 + Real.log 2 * (((normPrimes z).card : ℝ) + ((∑ p ∈ normPrimes z, (z.norm.natAbs.factorization p - 1) : ℕ) : ℝ)) at hlog have hexcess : (∑ p ∈ normPrimes z, (z.norm.natAbs.factorization p - 1)) ≤ GaussianExcess.excess (allPrimes R) z := by exact sum_le_sum_of_subset_of_nonneg (normPrimes_subset_all hz) (fun _ _ _ => Nat.zero_le _) have hlogTwo : 0 ≤ Real.log 2 := (Real.log_pos (by norm_num : (1 : ℝ) < 2)).le have h4 : 0 ≤ Real.log 4 := Real.log_nonneg (by norm_num) have hlo : Real.log 2 * (splitOmega (smallPrimes R) z : ℝ) ≤ Real.log ((normCircle z.norm.natAbs).card : ℝ) := by have hc : (splitOmega (smallPrimes R) z : ℝ) ≤ (normPrimes z).card := by exact_mod_cast hcounts.1 have hh := mul_le_mul_of_nonneg_left hc hlogTwo linarith [hlog.1] have hsum : ((normPrimes z).card : ℝ) + ((∑ p ∈ normPrimes z, (z.norm.natAbs.factorization p - 1) : ℕ) : ℝ) ≤ (splitOmega (smallPrimes R) z : ℝ) + 40 + (GaussianExcess.excess (allPrimes R) z : ℝ) := by exact_mod_cast Nat.add_le_add hcounts.2 hexcess have hupper : Real.log ((normCircle z.norm.natAbs).card : ℝ) ≤ Real.log 4 + Real.log 2 * ((splitOmega (smallPrimes R) z : ℝ) + 40 + (GaussianExcess.excess (allPrimes R) z : ℝ)) := by have hh := mul_le_mul_of_nonneg_left hsum hlogTwo linarith [hlog.2] rw [abs_of_nonneg (sub_nonneg.mpr hlo)] nlinarith /-- Deterministic Markov bound for the actual repeated-factor statistic. -/ theorem excess_exceptional_card_upper (T : Finset ℕ) (hT : ∀ p ∈ T, p.Prime ∧ p % 4 = 1) {R a : ℝ} (hR : 0 ≤ R) (ha : 0 < a) : (((GaussianMass.representatives (R ^ 2)).filter (fun z => a ≤ (GaussianExcess.excess T z : ℝ))).card : ℝ) ≤ (108 * Real.pi) * R ^ 2 / a := by let B := (GaussianMass.representatives (R ^ 2)).filter (fun z => a ≤ (GaussianExcess.excess T z : ℝ)) apply (le_div_iff₀ ha).mpr change (B.card : ℝ) * a ≤ _ calc (B.card : ℝ) * a = ∑ _z ∈ B, a := by simp _ ≤ ∑ z ∈ B, (GaussianExcess.excess T z : ℝ) := sum_le_sum (fun z hz => (mem_filter.mp hz).2) _ ≤ ∑ z ∈ GaussianMass.representatives (R ^ 2), (GaussianExcess.excess T z : ℝ) := sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun _ _ _ => by positivity) _ ≤ _ := GaussianExcess.excess_sum_le T hT hR /-- Strict failure of the logarithmic normal-order window. -/ def logarithmBad (R ε : ℝ) : Finset GaussianInt := (GaussianMass.representatives (R ^ 2)).filter (fun z => ε * Real.log (Real.log R) < |Real.log ((normCircle z.norm.natAbs).card : ℝ) - Real.log 2 * Real.log (Real.log R)|) /-- The two genuine exceptional populations used in the final comparison. -/ def exceptional (R k : ℝ) : Finset GaussianInt := ((GaussianMass.representatives (R ^ 2)).filter (fun z => k * Real.log (Real.log R) ≤ |(splitOmega (smallPrimes R) z : ℝ) - center (smallPrimes R)|)) ∪ ((GaussianMass.representatives (R ^ 2)).filter (fun z => k * Real.log (Real.log R) ≤ (GaussianExcess.excess (allPrimes R) z : ℝ))) /-- This explicit upper bound tends to zero using the already proved density-center and lattice-boundary limits. -/ def errorBound (R k : ℝ) : ℝ := (Real.pi / k ^ 2) * (center (smallPrimes R) / Real.log (Real.log R)) * (Real.log (Real.log R))⁻¹ + ((64 * Real.pi + 4) / k ^ 2) * (((R + 1) * ((smallPrimes R).card : ℝ) ^ 2) / R ^ 2) * ((Real.log (Real.log R))⁻¹) ^ 2 + ((108 * Real.pi) / k) * (Real.log (Real.log R))⁻¹ lemma tendsto_errorBound (k : ℝ) : Tendsto (fun R : ℝ => errorBound R k) atTop (𝓝 0) := by have hinv : Tendsto (fun R : ℝ => (Real.log (Real.log R))⁻¹) atTop (𝓝 0) := tendsto_inv_atTop_zero.comp GaussianCutoff.tendsto_loglog have h1 := (GaussianCutoff.tendsto_center_div_loglog.mul hinv).const_mul (Real.pi / k ^ 2) have h2 := (GaussianCutoff.tendsto_boundary_error.mul (hinv.pow 2)).const_mul ((64 * Real.pi + 4) / k ^ 2) have h3 := hinv.const_mul ((108 * Real.pi) / k) simpa only [errorBound, mul_assoc, mul_zero, one_mul, zero_pow (by decide : 2 ≠ 0), zero_add] using (h1.add h2).add h3 lemma exceptional_card_bound {R k : ℝ} (hR : 0 < R) (hk : 0 < k) (hlog : 0 < Real.log (Real.log R)) : ((exceptional R k).card : ℝ) / R ^ 2 ≤ errorBound R k := by have ha : 0 < k * Real.log (Real.log R) := mul_pos hk hlog have hT : ∀ p ∈ smallPrimes R, p.Prime ∧ p % 4 = 1 := fun p hp => (mem_smallPrimes hp).2 have hw := exceptional_card_upper (smallPrimes R) hT hR.le ha have he := excess_exceptional_card_upper (allPrimes R) (allPrimes_spec R) hR.le ha have hu : ((exceptional R k).card : ℝ) ≤ (((GaussianMass.representatives (R ^ 2)).filter (fun z => k * Real.log (Real.log R) ≤ |(splitOmega (smallPrimes R) z : ℝ) - center (smallPrimes R)|)).card : ℝ) + (((GaussianMass.representatives (R ^ 2)).filter (fun z => k * Real.log (Real.log R) ≤ (GaussianExcess.excess (allPrimes R) z : ℝ))).card : ℝ) := by unfold exceptional exact_mod_cast card_union_le _ _ have hh := div_le_div_of_nonneg_right (hu.trans (add_le_add hw he)) (sq_nonneg R) have heq : ((Real.pi * R ^ 2 * center (smallPrimes R) + (64 * Real.pi + 4) * (R + 1) * ((smallPrimes R).card : ℝ) ^ 2) / (k * Real.log (Real.log R)) ^ 2 + (108 * Real.pi) * R ^ 2 / (k * Real.log (Real.log R))) / R ^ 2 = errorBound R k := by unfold errorBound field_simp [ne_of_gt hR, ne_of_gt hk, ne_of_gt hlog] exact hh.trans_eq heq lemma logarithmBad_subset_exceptional {R ε k : ℝ} (hR : 1 < R) (hM : R ^ (1 / 20 : ℝ) ≤ (cutoff R : ℝ)) (hbudget : Real.log 4 + 40 * Real.log 2 + Real.log 2 * |center (smallPrimes R) - Real.log (Real.log R)| + 2 * Real.log 2 * k * Real.log (Real.log R) ≤ ε * Real.log (Real.log R)) : logarithmBad R ε ⊆ exceptional R k := by intro z hz have hzP := (mem_filter.mp hz).1 have hzbad := (mem_filter.mp hz).2 by_contra hzex have hw : |(splitOmega (smallPrimes R) z : ℝ) - center (smallPrimes R)| < k * Real.log (Real.log R) := by apply lt_of_not_ge intro hw exact hzex (mem_union_left _ (mem_filter.mpr ⟨hzP, hw⟩)) have he : (GaussianExcess.excess (allPrimes R) z : ℝ) < k * Real.log (Real.log R) := by apply lt_of_not_ge intro he exact hzex (mem_union_right _ (mem_filter.mpr ⟨hzP, he⟩)) have hp := logarithm_pointwise_error hR hM hzP have hlogTwo : 0 ≤ Real.log 2 := (Real.log_pos (by norm_num : (1 : ℝ) < 2)).le have ht := abs_sub_le (Real.log ((normCircle z.norm.natAbs).card : ℝ)) (Real.log 2 * (splitOmega (smallPrimes R) z : ℝ)) (Real.log 2 * Real.log (Real.log R)) have ht' := abs_sub_le (splitOmega (smallPrimes R) z : ℝ) (center (smallPrimes R)) (Real.log (Real.log R)) have hm := mul_le_mul_of_nonneg_left ht' hlogTwo have hw' := mul_le_mul_of_nonneg_left hw.le hlogTwo have he' := mul_le_mul_of_nonneg_left he.le hlogTwo have habs : |Real.log 2 * (splitOmega (smallPrimes R) z : ℝ) - Real.log 2 * Real.log (Real.log R)| = Real.log 2 * |(splitOmega (smallPrimes R) z : ℝ) - Real.log (Real.log R)| := by rw [← mul_sub, abs_mul, abs_of_nonneg hlogTwo] nlinarith lemma tendsto_deterministic_error : Tendsto (fun R : ℝ => (Real.log 4 + 40 * Real.log 2) / Real.log (Real.log R) + Real.log 2 * |center (smallPrimes R) / Real.log (Real.log R) - 1|) atTop (𝓝 0) := by have h1 := GaussianCutoff.tendsto_const_div_loglog (Real.log 4 + 40 * Real.log 2) have h2 := (GaussianCutoff.tendsto_center_div_loglog.sub (tendsto_const_nhds (x := (1 : ℝ)))).abs simpa only [sub_self, abs_zero, mul_zero, add_zero] using h1.add (h2.const_mul (Real.log 2)) /-- Outside o(R²) actual nonzero vectors, the logarithm of the norm-circle cardinality is `(log 2 + o(1))*log(log R)`. -/ theorem tendsto_logarithmBad_card {ε : ℝ} (hε : 0 < ε) : Tendsto (fun R : ℝ => ((logarithmBad R ε).card : ℝ) / R ^ 2) atTop (𝓝 0) := by have hlogTwo : 0 < Real.log 2 := Real.log_pos (by norm_num) let k := ε / (4 * Real.log 2) have hk : 0 < k := by dsimp [k]; positivity have hsmall := tendsto_deterministic_error.eventually (gt_mem_nhds (show (0 : ℝ) < ε / 2 by positivity)) apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds (tendsto_errorBound k) · exact Eventually.of_forall fun R => div_nonneg (Nat.cast_nonneg _) (sq_nonneg R) · filter_upwards [hsmall, eventually_cutoff_bounds, eventually_gt_atTop (1 : ℝ), GaussianCutoff.tendsto_loglog.eventually (eventually_gt_atTop 0)] with R hsmall hM hR hlog have hscale : ((Real.log 4 + 40 * Real.log 2) / Real.log (Real.log R) + Real.log 2 * |center (smallPrimes R) / Real.log (Real.log R) - 1|) * Real.log (Real.log R) = Real.log 4 + 40 * Real.log 2 + Real.log 2 * |center (smallPrimes R) - Real.log (Real.log R)| := by have heq : center (smallPrimes R) / Real.log (Real.log R) - 1 = (center (smallPrimes R) - Real.log (Real.log R)) / Real.log (Real.log R) := by field_simp rw [heq, abs_div, abs_of_pos hlog] field_simp have hdet := mul_le_mul_of_nonneg_right hsmall.le hlog.le rw [hscale] at hdet have hkEq : 2 * Real.log 2 * k = ε / 2 := by dsimp [k] field_simp ring have hbudget : Real.log 4 + 40 * Real.log 2 + Real.log 2 * |center (smallPrimes R) - Real.log (Real.log R)| + 2 * Real.log 2 * k * Real.log (Real.log R) ≤ ε * Real.log (Real.log R) := by rw [hkEq] nlinarith have hsub := logarithmBad_subset_exceptional hR hM.1 hbudget have hc : ((logarithmBad R ε).card : ℝ) ≤ (exceptional R k).card := by exact_mod_cast card_le_card hsub exact (div_le_div_of_nonneg_right hc (sq_nonneg R)).trans (exceptional_card_bound (lt_trans zero_lt_one hR) hk hlog) /-- Failure of the exact power window in the point-weighted statement. -/ def normalBad (R ε : ℝ) : Finset GaussianInt := (GaussianMass.representatives (R ^ 2)).filter (fun z => ((normCircle z.norm.natAbs).card : ℝ) < (Real.log R) ^ (Real.log 2 - ε) ∨ (Real.log R) ^ (Real.log 2 + ε) < ((normCircle z.norm.natAbs).card : ℝ)) lemma normalBad_subset_logarithmBad {R ε : ℝ} (hR : 1 < R) : normalBad R ε ⊆ logarithmBad R ε := by intro z hz obtain ⟨hzP, hzbad⟩ := mem_filter.mp hz refine mem_filter.mpr ⟨hzP, ?_⟩ have hc : (0 : ℝ) < (normCircle z.norm.natAbs).card := by exact_mod_cast card_pos.mpr (show (normCircle z.norm.natAbs).Nonempty from ⟨z, self_mem_normCircle z⟩) have hlogR : 0 < Real.log R := Real.log_pos hR have habs1 := le_abs_self (Real.log ((normCircle z.norm.natAbs).card : ℝ) - Real.log 2 * Real.log (Real.log R)) have habs2 := neg_le_abs (Real.log ((normCircle z.norm.natAbs).card : ℝ) - Real.log 2 * Real.log (Real.log R)) rcases hzbad with hlo | hhi · have hl := (Real.log_lt_log_iff hc (Real.rpow_pos_of_pos hlogR _)).mpr hlo rw [Real.log_rpow hlogR] at hl nlinarith · have hh := (Real.log_lt_log_iff (Real.rpow_pos_of_pos hlogR _) hc).mpr hhi rw [Real.log_rpow hlogR] at hh nlinarith /-- Point-weighted normal order, at every real radius, with the genuine representation count and no external normal-order assumption. -/ theorem tendsto_normalBad_card {ε : ℝ} (hε : 0 < ε) : Tendsto (fun R : ℝ => ((normalBad R ε).card : ℝ) / R ^ 2) atTop (𝓝 0) := by apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds (tendsto_logarithmBad_card hε) · exact Eventually.of_forall fun R => div_nonneg (Nat.cast_nonneg _) (sq_nonneg R) · filter_upwards [eventually_gt_atTop (1 : ℝ)] with R hR have hc : ((normalBad R ε).card : ℝ) ≤ (logarithmBad R ε).card := by exact_mod_cast card_le_card (normalBad_subset_logarithmBad (ε := ε) hR) exact div_le_div_of_nonneg_right hc (sq_nonneg R) end DistanceCounts.GaussianNormalOrder end end BodyFile032 -- Source: DistanceCounts/LowPalette.lean section BodyFile033 noncomputable section namespace DistanceCounts.LowPalette open Finset Filter open scoped Classical Topology abbrev population (R : ℝ) := GaussianMass.representatives (R ^ 2) def norms (R : ℝ) : Finset ℕ := (population R).image (fun z => z.norm.natAbs) /-- Norms of the actual vectors in one canonical Gaussian quotient class. -/ def normPalette {q : ℕ} (a : GaussianResidues.Residue q) (R : ℝ) : Finset ℕ := ((population R).filter (fun z => GaussianNorm.residue q z = a)).image (fun z => z.norm.natAbs) /-- Every class of the quotient, including the zero class. -/ def allResidues (q : ℕ) (hq : 0 < q) : Finset (GaussianResidues.Residue q) := @Finset.univ _ (@Fintype.ofFinite _ (GaussianResidues.finite_residue q hq)) lemma mem_allResidues (q : ℕ) (hq : 0 < q) (a : GaussianResidues.Residue q) : a ∈ allResidues q hq := by letI : Fintype (GaussianResidues.Residue q) := @Fintype.ofFinite _ (GaussianResidues.finite_residue q hq) exact Finset.mem_univ a def aggregate (q : ℕ) (hq : 0 < q) (R : ℝ) : ℝ := ∑ a ∈ allResidues q hq, ((normPalette a R).card : ℝ) def circleResidues (q n : ℕ) : Finset (GaussianResidues.Residue q) := (normCircle n).image (GaussianNorm.residue q) lemma mem_norms_bounds {R : ℝ} {n : ℕ} (hn : n ∈ norms R) : 0 < n ∧ (n : ℝ) ≤ R ^ 2 := by obtain ⟨z, hz, rfl⟩ := mem_image.mp hn obtain ⟨hz0, hzR⟩ := (GaussianMass.mem_representatives (sq_nonneg R) z).mp hz exact ⟨Nat.pos_of_ne_zero (GaussianNormalOrder.natNorm_ne_zero hz0), hzR⟩ /-- A positive norm below the cutoff has its entire circle in the population. -/ theorem population_norm_fiber {R : ℝ} {n : ℕ} (hn : 0 < n) (hnR : (n : ℝ) ≤ R ^ 2) : (population R).filter (fun z => z.norm.natAbs = n) = normCircle n := by ext z rw [mem_filter, mem_normCircle] constructor · exact fun h => h.2 · intro hz refine ⟨(GaussianMass.mem_representatives (sq_nonneg R) z).mpr ⟨?_, ?_⟩, hz⟩ · exact ne_zero_of_mem_normCircle hn.ne' ((mem_normCircle n z).mpr hz) · simpa only [hz] using hnR lemma population_norm_fiber_of_mem {R : ℝ} {n : ℕ} (hn : n ∈ norms R) : (population R).filter (fun z => z.norm.natAbs = n) = normCircle n := population_norm_fiber (mem_norms_bounds hn).1 (mem_norms_bounds hn).2 lemma good_circle_lower {R ε : ℝ} {z : GaussianInt} (hz : z ∈ population R) (hgood : z ∉ GaussianNormalOrder.normalBad R ε) : (Real.log R) ^ (Real.log 2 - ε) ≤ ((normCircle z.norm.natAbs).card : ℝ) := by apply le_of_not_gt intro h exact hgood (mem_filter.mpr ⟨hz, Or.inl h⟩) lemma normPalette_eq_filter {q : ℕ} (a : GaussianResidues.Residue q) (R : ℝ) : normPalette a R = (norms R).filter (fun n => a ∈ circleResidues q n) := by ext n constructor · intro hn obtain ⟨z, hz, hzn⟩ := mem_image.mp hn obtain ⟨hzP, hza⟩ := mem_filter.mp hz exact mem_filter.mpr ⟨mem_image.mpr ⟨z, hzP, hzn⟩, mem_image.mpr ⟨z, (mem_normCircle n z).mpr hzn, hza⟩⟩ · intro hn obtain ⟨hn, ha⟩ := mem_filter.mp hn obtain ⟨z, hz, hza⟩ := mem_image.mp ha have hzP : z ∈ population R := by have : z ∈ (population R).filter (fun z => z.norm.natAbs = n) := by rw [population_norm_fiber_of_mem hn] exact hz exact (mem_filter.mp this).1 exact mem_image.mpr ⟨z, mem_filter.mpr ⟨hzP, hza⟩, (mem_normCircle n z).mp hz⟩ /-- Exact double counting of norm/residue incidences, not vectors. -/ theorem aggregate_eq_sum_circleResidues (q : ℕ) (hq : 0 < q) (R : ℝ) : aggregate q hq R = ∑ n ∈ norms R, ((circleResidues q n).card : ℝ) := by unfold aggregate simp only [normPalette_eq_filter, card_eq_sum_ones, Nat.cast_sum, Nat.cast_one, sum_filter] rw [sum_comm] apply sum_congr rfl intro n hn have hsub : circleResidues q n ⊆ allResidues q hq := fun a _ => mem_allResidues q hq a simp only [Nat.cast_ite, Nat.cast_one, Nat.cast_zero] rw [← sum_filter] have heq : (allResidues q hq).filter (fun a => a ∈ circleResidues q n) = circleResidues q n := by ext a simp only [mem_filter] exact ⟨fun h => h.2, fun h => ⟨hsub h, h⟩⟩ rw [heq] /-- Actual circle residues inject into the corresponding quotient norm fiber. -/ theorem circleResidues_card_le (P : Finset ℕ) (hprime : ∀ p ∈ P, p.Prime) (hfour : P.card ≤ 4) (n : ℕ) : (circleResidues (∏ p ∈ P, p) n).card ≤ 16 * (∏ p ∈ P, p) := by let q := ∏ p ∈ P, p have hq : 0 < q := prod_pos (fun p hp => (hprime p hp).pos) letI : Finite (GaussianResidues.Residue q) := GaussianResidues.finite_residue q hq let f : {a // a ∈ circleResidues q n} → {a : GaussianResidues.Residue q // GaussianResidues.norm q a = (n : ZMod q)} := fun a => ⟨a.1, by obtain ⟨z, hz, hza⟩ := mem_image.mp a.2 rw [← hza, GaussianResidues.norm_residue, (mem_normCircle_iff_norm n z).mp hz] simp⟩ have hf : Function.Injective f := by intro a b hab have hab' : a.1 = b.1 := congrArg (fun x : {a : GaussianResidues.Residue q // GaussianResidues.norm q a = (n : ZMod q)} => x.1) hab exact Subtype.ext hab' have hh := Nat.card_le_card_of_injective f hf rw [Nat.card_eq_finsetCard] at hh exact hh.trans (GaussianResidues.card_norm_fiber_four_primes P hprime hfour _) lemma sum_circle_card (R : ℝ) : ∑ n ∈ norms R, ((normCircle n).card : ℝ) = (population R).card := by have h := card_eq_sum_card_image (fun z : GaussianInt => z.norm.natAbs) (population R) change (population R).card = ∑ n ∈ norms R, ((population R).filter (fun z => z.norm.natAbs = n)).card at h rw [sum_congr rfl (fun n hn => congrArg Finset.card (population_norm_fiber_of_mem hn))] at h exact_mod_cast h.symm /-- The error is point-weighted once: bad incidences are bounded by the actual bad vectors, with no factor depending on the modulus. -/ theorem aggregate_le (P : Finset ℕ) (hprime : ∀ p ∈ P, p.Prime) (hfour : P.card ≤ 4) {R ε : ℝ} (hR : 1 < R) : aggregate (∏ p ∈ P, p) (prod_pos (fun p hp => (hprime p hp).pos)) R ≤ (16 * ((∏ p ∈ P, p : ℕ) : ℝ) / (Real.log R) ^ (Real.log 2 - ε)) * (population R).card + (GaussianNormalOrder.normalBad R ε).card := by let q := ∏ p ∈ P, p let T := (Real.log R) ^ (Real.log 2 - ε) let B := GaussianNormalOrder.normalBad R ε have hT : 0 < T := Real.rpow_pos_of_pos (Real.log_pos hR) _ have hK : 0 ≤ (16 * (q : ℝ) / T) := by positivity have hB : B ⊆ population R := filter_subset _ _ have hBsum : ∑ n ∈ norms R, (((B.filter (fun z => z.norm.natAbs = n)).card) : ℝ) = B.card := by have h := card_eq_sum_card_fiberwise (f := fun z : GaussianInt => z.norm.natAbs) (s := B) (t := norms R) (fun z hz => mem_image_of_mem _ (hB hz)) exact_mod_cast h.symm rw [aggregate_eq_sum_circleResidues] calc ∑ n ∈ norms R, ((circleResidues q n).card : ℝ) ≤ ∑ n ∈ norms R, ((16 * (q : ℝ) / T) * (normCircle n).card + ((B.filter (fun z => z.norm.natAbs = n)).card : ℝ)) := by apply sum_le_sum intro n hn by_cases hgood : T ≤ ((normCircle n).card : ℝ) · have hc : ((circleResidues q n).card : ℝ) ≤ 16 * (q : ℝ) := by exact_mod_cast circleResidues_card_le P hprime hfour n have hscale := mul_le_mul_of_nonneg_left hgood hK have hcancel : (16 * (q : ℝ) / T) * T = 16 * (q : ℝ) := div_mul_cancel₀ _ hT.ne' rw [hcancel] at hscale exact (hc.trans hscale).trans (le_add_of_nonneg_right (Nat.cast_nonneg _)) · have hbad : ((normCircle n).card : ℝ) < T := lt_of_not_ge hgood have hf : B.filter (fun z => z.norm.natAbs = n) = normCircle n := by change (GaussianNormalOrder.normalBad R ε).filter (fun z => z.norm.natAbs = n) = normCircle n ext z rw [mem_filter, GaussianNormalOrder.normalBad, mem_filter, mem_normCircle] constructor · exact fun h => h.2 · intro hzn have hzP : z ∈ population R := by have hz : z ∈ (population R).filter (fun z => z.norm.natAbs = n) := by rw [population_norm_fiber_of_mem hn] exact (mem_normCircle n z).mpr hzn exact (mem_filter.mp hz).1 exact ⟨⟨hzP, Or.inl (by simpa only [hzn] using hbad)⟩, hzn⟩ rw [hf] have hc : ((circleResidues q n).card : ℝ) ≤ (normCircle n).card := by exact_mod_cast card_image_le (f := GaussianNorm.residue q) (s := normCircle n) exact hc.trans (le_add_of_nonneg_left (mul_nonneg hK (Nat.cast_nonneg _))) _ = (16 * (q : ℝ) / T) * (population R).card + B.card := by rw [sum_add_distrib, ← mul_sum, sum_circle_card, hBsum] /-- The original nonzero radius-R population has density pi. -/ theorem tendsto_population_card : Tendsto (fun R : ℝ => ((population R).card : ℝ) / R ^ 2) atTop (𝓝 Real.pi) := by let b : ℝ → ℝ := fun R => 4 * (Real.pi + 1) * (R⁻¹ + (R⁻¹) ^ 2) have hi : Tendsto (fun R : ℝ => R⁻¹) atTop (𝓝 0) := tendsto_inv_atTop_zero have hb : Tendsto b atTop (𝓝 0) := by simpa [b] using (hi.add (hi.pow 2)).const_mul (4 * (Real.pi + 1)) apply tendsto_of_tendsto_of_tendsto_of_le_of_le' (by simpa using (tendsto_const_nhds (x := Real.pi)).sub hb) (by simpa using (tendsto_const_nhds (x := Real.pi)).add hb) all_goals filter_upwards [eventually_gt_atTop (0 : ℝ)] with R hR have hc := GaussianMass.classBall_card_error (sq_nonneg R) rw [Real.sqrt_sq hR.le] at hc have hp : ((population R).card : ℝ) = 4 * ((GaussianMass.classBall (R ^ 2)).card : ℝ) := by exact_mod_cast GaussianMass.representatives_card (sq_nonneg R) have hlo := (abs_le.mp hc).1 have hhi := (abs_le.mp hc).2 have hbR : b R * R ^ 2 = 4 * (Real.pi + 1) * (R + 1) := by dsimp [b] field_simp [hR.ne'] <;> ring first | apply (le_div_iff₀ (sq_pos_of_pos hR)).mpr rw [hp] nlinarith | apply (div_le_iff₀ (sq_pos_of_pos hR)).mpr rw [hp] nlinarith /-- Explicit radius-only error; no modulus appears in the exceptional term. -/ def error (c R : ℝ) : ℝ := 16 * (Real.log R) ^ (-((Real.log 2 - c) / 2)) * (((population R).card : ℝ) / R ^ 2) + ((GaussianNormalOrder.normalBad R ((Real.log 2 - c) / 2)).card : ℝ) / R ^ 2 theorem tendsto_error {c : ℝ} (hc : c < Real.log 2) : Tendsto (error c) atTop (𝓝 0) := by unfold error have hε : 0 < (Real.log 2 - c) / 2 := by linarith have hp := (tendsto_rpow_neg_atTop hε).comp Real.tendsto_log_atTop have h := ((hp.const_mul 16).mul tendsto_population_card).add (GaussianNormalOrder.tendsto_normalBad_card hε) simpa only [Function.comp_def, mul_zero, zero_mul, zero_add] using h /-- Uniform low-denominator transition. Inertness is unnecessary: the bound holds for every product of at most four distinct primes, hence for inert ones. -/ theorem aggregate_div_sq_le_error {c R : ℝ} (hc : c < Real.log 2) (hR : 1 < R) (P : Finset ℕ) (hprime : ∀ p ∈ P, p.Prime) (hfour : P.card ≤ 4) (hq : ((∏ p ∈ P, p : ℕ) : ℝ) ≤ (Real.log R) ^ c) : aggregate (∏ p ∈ P, p) (prod_pos (fun p hp => (hprime p hp).pos)) R / R ^ 2 ≤ error c R := by let ε := (Real.log 2 - c) / 2 have hlog : 0 < Real.log R := Real.log_pos hR have hT : 0 < (Real.log R) ^ (Real.log 2 - ε) := Real.rpow_pos_of_pos hlog _ have hratio : (16 * ((∏ p ∈ P, p : ℕ) : ℝ)) / (Real.log R) ^ (Real.log 2 - ε) ≤ 16 * (Real.log R) ^ (-ε) := by calc _ ≤ (16 * (Real.log R) ^ c) / (Real.log R) ^ (Real.log 2 - ε) := div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_left hq (by norm_num)) hT.le _ = _ := by rw [mul_div_assoc, ← Real.rpow_sub hlog] congr 2 dsimp [ε] ring have h := div_le_div_of_nonneg_right (aggregate_le P hprime hfour (ε := ε) hR) (sq_nonneg R) have hm := mul_le_mul_of_nonneg_right hratio (div_nonneg (Nat.cast_nonneg (population R).card) (sq_nonneg R)) rw [add_div, mul_div_assoc] at h apply h.trans change (16 * ((∏ p ∈ P, p : ℕ) : ℝ) / (Real.log R) ^ (Real.log 2 - ε)) * (((population R).card : ℝ) / R ^ 2) + ((GaussianNormalOrder.normalBad R ε).card : ℝ) / R ^ 2 ≤ 16 * (Real.log R) ^ (-ε) * (((population R).card : ℝ) / R ^ 2) + ((GaussianNormalOrder.normalBad R ε).card : ℝ) / R ^ 2 linarith only [hm] theorem eventually_uniform_low {c : ℝ} (hc : c < Real.log 2) : ∀ᶠ R : ℝ in atTop, ∀ P : Finset ℕ, ∀ hprime : ∀ p ∈ P, p.Prime, P.card ≤ 4 → ((∏ p ∈ P, p : ℕ) : ℝ) ≤ (Real.log R) ^ c → aggregate (∏ p ∈ P, p) (prod_pos (fun p hp => (hprime p hp).pos)) R / R ^ 2 ≤ error c R := by filter_upwards [eventually_gt_atTop (1 : ℝ)] with R hR exact fun P hprime hfour hq => aggregate_div_sq_le_error hc hR P hprime hfour hq end DistanceCounts.LowPalette end end BodyFile033 -- Source: DistanceCounts/PrimitiveNormPairs.lean section BodyFile034 /-! Gcd-based primitive equal-norm pairs and their exact transverse congruences. -/ noncomputable section namespace DistanceCounts.PrimitiveNormPairs /-- Coprime equal-norm Gaussian integers are conjugate up to an actual unit. -/ theorem coprime_equal_norm_conjugate {v t : GaussianInt} (hv : v ≠ 0) (hcop : IsCoprime v t) (hn : v.norm = t.norm) : ∃ u : GaussianIntˣ, t = (u : GaussianInt) * star v := by have hd : v ∣ t * star t := by rw [← Zsqrtd.norm_eq_mul_conj, ← hn, Zsqrtd.norm_eq_mul_conj] exact dvd_mul_right _ _ obtain ⟨a, ha⟩ := hcop.dvd_of_dvd_mul_left hd have hvN : v.norm ≠ 0 := GaussianInt.norm_eq_zero.not.mpr hv have haN : a.norm = 1 := by have he := congrArg Zsqrtd.norm ha rw [Zsqrtd.norm_conj, Zsqrtd.norm_mul, ← hn] at he apply mul_left_cancel₀ hvN simpa only [mul_one] using he.symm have hau : IsUnit (star a) := (Zsqrtd.norm_eq_one_iff.mp (show a.norm.natAbs = 1 by simp [haN])).star obtain ⟨u, hu⟩ := hau refine ⟨u, ?_⟩ have he := congrArg star ha simpa only [star_star, star_mul, ← hu] using he /-- The common factor is the actual gcd, and the primitive vector is its actual Euclidean quotient. Coprimality with the conjugate is derived, not assumed. -/ theorem gcd_decomposition {z w : GaussianInt} (hz : z ≠ 0) (hw : w ≠ 0) (hn : z.norm = w.norm) : ∃ (g v : GaussianInt) (u : GaussianIntˣ), g = EuclideanDomain.gcd z w ∧ v = z / EuclideanDomain.gcd z w ∧ g ≠ 0 ∧ v ≠ 0 ∧ z = g * v ∧ w = g * (u : GaussianInt) * star v ∧ IsCoprime v (star v) := by letI : GCDMonoid GaussianInt := EuclideanDomain.gcdMonoid GaussianInt let g := GCDMonoid.gcd z w let v := z / g let t := w / g have hg : g ≠ 0 := gcd_ne_zero_of_left hz have hv : v ≠ 0 := left_div_gcd_ne_zero hz have hzv : z = g * v := (EuclideanDomain.mul_div_cancel' hg (GCDMonoid.gcd_dvd_left z w)).symm have hwt : w = g * t := (EuclideanDomain.mul_div_cancel' hg (GCDMonoid.gcd_dvd_right z w)).symm have hcop : IsCoprime v t := isCoprime_div_gcd_div_gcd hw have hvt : v.norm = t.norm := by rw [hzv, hwt, Zsqrtd.norm_mul, Zsqrtd.norm_mul] at hn exact mul_left_cancel₀ (GaussianInt.norm_eq_zero.not.mpr hg) hn obtain ⟨u, hu⟩ := coprime_equal_norm_conjugate hv hcop hvt refine ⟨g, v, u, rfl, rfl, hg, hv, hzv, ?_, ?_⟩ · rw [hwt, hu, mul_assoc] · apply hcop.of_isCoprime_of_dvd_right rw [hu] exact dvd_mul_left _ _ /-- Cancelling the gcd preserves the exact Gaussian congruence. Neither oddness nor positivity is needed for cancellation itself. -/ theorem cancel_common_factor {q : ℕ} {z w g v : GaussianInt} {u : GaussianIntˣ} (hz : z = g * v) (hw : w = g * (u : GaussianInt) * star v) (hcop : IsCoprime (q : GaussianInt) g) (hd : (q : GaussianInt) ∣ z - w) : (q : GaussianInt) ∣ v - (u : GaussianInt) * star v := by apply hcop.dvd_of_dvd_mul_left simpa only [hz, hw, mul_sub, mul_assoc] using hd /-- Exhaustive enumeration of the four actual Gaussian units. -/ theorem unit_values (u : GaussianIntˣ) : (u : GaussianInt) = ⟨1, 0⟩ ∨ (u : GaussianInt) = ⟨-1, 0⟩ ∨ (u : GaussianInt) = ⟨0, 1⟩ ∨ (u : GaussianInt) = ⟨0, -1⟩ := by have h := (mem_normCircle_one_iff (u : GaussianInt)).mpr u.isUnit rw [normCircle_one] at h simpa only [Finset.mem_insert, Finset.mem_singleton] using h /-- The exact transverse coefficients, with no unit or rational factor dropped. -/ theorem transverse_differences (v : GaussianInt) : v - (⟨1, 0⟩ : GaussianInt) * star v = ⟨0, 2 * v.im⟩ ∧ v - (⟨-1, 0⟩ : GaussianInt) * star v = ⟨2 * v.re, 0⟩ ∧ v - (⟨0, 1⟩ : GaussianInt) * star v = ⟨v.re - v.im, -(v.re - v.im)⟩ ∧ v - (⟨0, -1⟩ : GaussianInt) * star v = ⟨v.re + v.im, v.re + v.im⟩ := by refine ⟨?_, ?_, ?_, ?_⟩ <;> ext <;> simp <;> ring private theorem odd_dvd_two_mul_iff {q a : ℤ} (hq : Odd q) : q ∣ 2 * a ↔ q ∣ a := by constructor · intro h obtain ⟨k, hk⟩ := hq have he : q * a - k * (2 * a) = a := by rw [hk]; ring rw [← he] exact dvd_sub (dvd_mul_right q a) (dvd_mul_of_dvd_right h k) · intro h exact dvd_mul_of_dvd_right h 2 private theorem rational_dvd_iff (q : ℕ) (v : GaussianInt) : (q : GaussianInt) ∣ v ↔ (q : ℤ) ∣ v.re ∧ (q : ℤ) ∣ v.im := by simpa only [Int.cast_natCast] using Zsqrtd.intCast_dvd (q : ℤ) v /-- For odd rational moduli, the four congruences are equivalences. The axis cases cancel precisely the factor two; the diagonal cases have coefficient one. -/ theorem transverse_congruences (q : ℕ) (hq : Odd q) (v : GaussianInt) : ((q : GaussianInt) ∣ v - (⟨1, 0⟩ : GaussianInt) * star v ↔ (q : ℤ) ∣ v.im) ∧ ((q : GaussianInt) ∣ v - (⟨-1, 0⟩ : GaussianInt) * star v ↔ (q : ℤ) ∣ v.re) ∧ ((q : GaussianInt) ∣ v - (⟨0, 1⟩ : GaussianInt) * star v ↔ (q : ℤ) ∣ v.re - v.im) ∧ ((q : GaussianInt) ∣ v - (⟨0, -1⟩ : GaussianInt) * star v ↔ (q : ℤ) ∣ v.re + v.im) := by have hqZ : Odd (q : ℤ) := by obtain ⟨k, hk⟩ := hq exact ⟨(k : ℤ), by exact_mod_cast hk⟩ obtain ⟨h₁, h₂, h₃, h₄⟩ := transverse_differences v rw [h₁, h₂, h₃, h₄] simp [rational_dvd_iff, odd_dvd_two_mul_iff hqZ] intro hd simpa only [neg_sub] using (dvd_neg.mpr hd) /-- A nonidentity equal-norm collision forces a nonzero transverse coordinate in the appropriate one of the four unit directions. -/ theorem nonzero_transverse {q : ℕ} (hq : Odd q) {v : GaussianInt} {u : GaussianIntˣ} (hd : (q : GaussianInt) ∣ v - (u : GaussianInt) * star v) (hne : v ≠ (u : GaussianInt) * star v) : ((q : ℤ) ∣ v.im ∧ v.im ≠ 0) ∨ ((q : ℤ) ∣ v.re ∧ v.re ≠ 0) ∨ ((q : ℤ) ∣ v.re - v.im ∧ v.re - v.im ≠ 0) ∨ ((q : ℤ) ∣ v.re + v.im ∧ v.re + v.im ≠ 0) := by obtain ⟨h₁, h₂, h₃, h₄⟩ := transverse_congruences q hq v rcases unit_values u with hu | hu | hu | hu · left refine ⟨h₁.mp (by simpa only [hu] using hd), ?_⟩ intro h apply hne ext <;> simp [hu, h] · right; left refine ⟨h₂.mp (by simpa only [hu] using hd), ?_⟩ intro h apply hne ext <;> simp [hu, h] · right; right; left refine ⟨h₃.mp (by simpa only [hu] using hd), ?_⟩ intro h apply hne ext <;> simp [hu] <;> omega · right; right; right refine ⟨h₄.mp (by simpa only [hu] using hd), ?_⟩ intro h apply hne ext <;> simp [hu] <;> omega /-- The gcd decomposition together with the transverse conclusion, for a positive odd modulus coprime to the actual common factor. -/ theorem collision_decomposition {q : ℕ} (_hq : 0 < q) (hqodd : Odd q) {z w : GaussianInt} (hz : z ≠ 0) (hw : w ≠ 0) (hn : z.norm = w.norm) (hne : w ≠ z) (hd : (q : GaussianInt) ∣ z - w) (hcop : IsCoprime (q : GaussianInt) (EuclideanDomain.gcd z w)) : ∃ (g v : GaussianInt) (u : GaussianIntˣ), g = EuclideanDomain.gcd z w ∧ v = z / EuclideanDomain.gcd z w ∧ g ≠ 0 ∧ v ≠ 0 ∧ z = g * v ∧ w = g * (u : GaussianInt) * star v ∧ IsCoprime v (star v) ∧ (((q : ℤ) ∣ v.im ∧ v.im ≠ 0) ∨ ((q : ℤ) ∣ v.re ∧ v.re ≠ 0) ∨ ((q : ℤ) ∣ v.re - v.im ∧ v.re - v.im ≠ 0) ∨ ((q : ℤ) ∣ v.re + v.im ∧ v.re + v.im ≠ 0)) := by obtain ⟨g, v, u, hgcd, hvdiv, hg, hv, hzv, hwv, hprim⟩ := gcd_decomposition hz hw hn refine ⟨g, v, u, hgcd, hvdiv, hg, hv, hzv, hwv, hprim, ?_⟩ apply nonzero_transverse hqodd · exact cancel_common_factor hzv hwv (hgcd.symm ▸ hcop) hd · intro he apply hne calc w = g * ((u : GaussianInt) * star v) := by rw [hwv, mul_assoc] _ = g * v := by rw [← he] _ = z := hzv.symm /-- Integer norms, natural norm masses, and genuine Euclidean lengths all retain their exact multiplicative relation after extracting the gcd. -/ theorem factor_norm_relations {z g v : GaussianInt} (hz : z = g * v) : z.norm = g.norm * v.norm ∧ z.norm.natAbs = g.norm.natAbs * v.norm.natAbs ∧ GaussianDivisibility.normMass z = GaussianDivisibility.normMass g * GaussianDivisibility.normMass v ∧ ‖(z : ℂ)‖ = ‖(g : ℂ)‖ * ‖(v : ℂ)‖ := by subst z exact ⟨Zsqrtd.norm_mul g v, by simp [Zsqrtd.norm_mul, Int.natAbs_mul], GaussianDivisibility.normMass_mul g v, by simp only [GaussianInt.toComplex_mul, norm_mul]⟩ /-- The common factor lies in the disk of the exact reciprocal primitive scale. -/ theorem common_factor_radius {z g v : GaussianInt} {R : ℝ} (hz : z = g * v) (hv : v ≠ 0) (hR : ‖(z : ℂ)‖ ≤ R) : ‖(g : ℂ)‖ ≤ R / ‖(v : ℂ)‖ := by have hvpos : 0 < ‖(v : ℂ)‖ := lt_of_lt_of_le (by norm_num) (GaussianDivisibility.one_le_complex_norm hv) apply (le_div_iff₀ hvpos).mpr rwa [← (factor_norm_relations hz).2.2.2] end DistanceCounts.PrimitiveNormPairs end end BodyFile034 -- Source: DistanceCounts/GaussianPrimeWeight.lean section BodyFile035 /-! A Chebyshev bound for the logarithmic first moment of genuine Gaussian primes. -/ noncomputable section namespace DistanceCounts.GaussianPrimeWeight open Finset GaussianMass open scoped Classical /-- All prime associate classes, with no choice of sign or conjugate. -/ def primeClassesY (Y : ℝ) : Finset (Associates GaussianInt) := (classBall Y).filter Prime lemma mem_primeClassesY {Y : ℝ} (hY : 0 ≤ Y) (a : Associates GaussianInt) : a ∈ primeClassesY Y ↔ Prime a ∧ (classNorm a : ℝ) ≤ Y := by rw [primeClassesY, mem_filter, mem_classBall hY] exact ⟨fun h => ⟨h.2, h.1.2⟩, fun h => ⟨⟨h.1.ne_zero, h.2⟩, h.1⟩⟩ lemma classNorm_natCast (n : ℕ) : classNorm (Associates.mk (n : GaussianInt)) = n ^ 2 := by simp [classNorm_mk, Zsqrtd.norm_natCast, pow_two, Int.natAbs_mul] /-- Primality detects a rational prime factor of a nonzero integer. -/ lemma prime_dvd_natCast_exists {a : Associates GaussianInt} (ha : Prime a) (n : ℕ) (hn : n ≠ 0) (hd : a ∣ Associates.mk (n : GaussianInt)) : ∃ p : ℕ, p.Prime ∧ a ∣ Associates.mk (p : GaussianInt) := by revert hn hd induction n using Nat.recOnMul with | zero => exact fun hn _ => (hn rfl).elim | one => exact fun _ hd => (ha.not_dvd_one (by simpa using hd)).elim | prime p hp => exact fun _ hd => ⟨p, hp, hd⟩ | mul m n hm ih => intro hn hd rw [Nat.cast_mul, ← Associates.mk_mul_mk] at hd rcases ha.dvd_or_dvd hd with hd | hd · exact hm (fun h => hn (by simp [h])) hd · exact ih (fun h => hn (by simp [h])) hd /-- Every Gaussian prime lies over a rational prime: use the actual identity `z * conjugate z = norm z`, rather than a prime-distribution hypothesis. -/ lemma prime_lies_over {a : Associates GaussianInt} (ha : Prime a) : ∃ p : ℕ, p.Prime ∧ a ∣ Associates.mk (p : GaussianInt) := by obtain ⟨z, rfl⟩ := Associates.mk_surjective a apply prime_dvd_natCast_exists ha z.norm.natAbs · exact ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) (classNorm_prime_two_le ha)) · apply Associates.mk_dvd_mk.mpr rw [GaussianInt.natCast_natAbs_norm, Zsqrtd.norm_eq_mul_conj] exact dvd_mul_right _ _ /-- A divisor of a rational prime either has that prime as its norm or is the entire rational prime class. The latter case includes inert primes. -/ lemma prime_over_classification {a : Associates GaussianInt} (ha : Prime a) {p : ℕ} (hp : p.Prime) (hd : a ∣ Associates.mk (p : GaussianInt)) : classNorm a = p ∨ a = Associates.mk (p : GaussianInt) := by obtain ⟨b, hb⟩ := hd by_cases hb1 : b = 1 · exact Or.inr (by simpa [hb1] using hb.symm) · have ha1 : classNorm a ≠ 1 := fun h => ha.ne_one ((classNorm_eq_one a).mp h) have hb1' : classNorm b ≠ 1 := fun h => hb1 ((classNorm_eq_one b).mp h) have he : classNorm a * classNorm b = p ^ 2 := by rw [← classNorm_mul, ← hb, classNorm_natCast] exact Or.inl ((hp.mul_eq_prime_sq_iff ha1 hb1').mp he).1 /-- In particular the norm is either the underlying rational prime or its square; no residue class, including the ramified prime, is excluded. -/ lemma prime_norm_classification {a : Associates GaussianInt} (ha : Prime a) : ∃ p : ℕ, p.Prime ∧ a ∣ Associates.mk (p : GaussianInt) ∧ (classNorm a = p ∨ classNorm a = p ^ 2) := by obtain ⟨p, hp, hd⟩ := prime_lies_over ha refine ⟨p, hp, hd, ?_⟩ rcases prime_over_classification ha hp hd with hn | he · exact Or.inl hn · exact Or.inr (he ▸ classNorm_natCast p) /-- The square-norm fiber over a fixed rational prime has only its rational associate class, rather than eight arbitrary representations of a square. -/ lemma prime_square_norm_over_eq {a : Associates GaussianInt} (ha : Prime a) {p : ℕ} (hp : p.Prime) (hd : a ∣ Associates.mk (p : GaussianInt)) (hn : classNorm a = p ^ 2) : a = Associates.mk (p : GaussianInt) := by rcases prime_over_classification ha hp hd with h | h · have he : p ^ 2 = p := hn.symm.trans h nlinarith [hp.two_le] · exact h /-- The prime-norm fiber is an image of the full norm circle, including both conjugate unit orbits. Eight is a deliberately loose bound on its cardinality. -/ def primeNormClasses (p : ℕ) : Finset (Associates GaussianInt) := (normCircle p).image Associates.mk lemma mem_primeNormClasses (p : ℕ) (a : Associates GaussianInt) : a ∈ primeNormClasses p ↔ classNorm a = p := by constructor · rintro ha obtain ⟨z, hz, rfl⟩ := mem_image.mp ha exact (mem_normCircle p z).mp hz · intro ha obtain ⟨z, rfl⟩ := Associates.mk_surjective a exact mem_image.mpr ⟨z, (mem_normCircle p z).mpr ha, rfl⟩ lemma primeNormClasses_card_le_eight {p : ℕ} (hp : p.Prime) : (primeNormClasses p).card ≤ 8 := (card_image_le).trans (normCircle_prime_card_le_eight hp) /-- This cover includes the ramified class, both split classes, and the inert class. It is allowed to contain a composite rational class in the split case. -/ def rationalPrimeCover (p : ℕ) : Finset (Associates GaussianInt) := primeNormClasses p ∪ {Associates.mk (p : GaussianInt)} lemma primeClassesY_subset_cover {Y : ℝ} (hY : 0 ≤ Y) : primeClassesY Y ⊆ (Nat.primesLE ⌊Y⌋₊).biUnion rationalPrimeCover := by intro a ha obtain ⟨hap, haY⟩ := (mem_primeClassesY hY a).mp ha obtain ⟨p, hp, hd⟩ := prime_lies_over hap obtain hn | he := prime_over_classification hap hp hd · apply mem_biUnion.mpr refine ⟨p, Nat.mem_primesLE.mpr ⟨?_, hp⟩, mem_union.mpr (Or.inl ?_)⟩ · apply (Nat.le_floor_iff hY).mpr simpa [hn] using haY · exact (mem_primeNormClasses p a).mpr hn · subst a apply mem_biUnion.mpr refine ⟨p, Nat.mem_primesLE.mpr ⟨?_, hp⟩, mem_union.mpr (Or.inr (mem_singleton_self _))⟩ apply (Nat.le_floor_iff hY).mpr have hpp : p ≤ p ^ 2 := by nlinarith [hp.two_le] exact (by exact_mod_cast hpp : (p : ℝ) ≤ (p ^ 2 : ℕ)).trans (by simpa [classNorm_natCast] using haY) def weight (a : Associates GaussianInt) : ℝ := Real.log (classNorm a) / classNorm a lemma weight_nonneg (a : Associates GaussianInt) : 0 ≤ weight a := by unfold weight by_cases h : classNorm a = 0 · simp [h] · exact div_nonneg (Real.log_nonneg (by exact_mod_cast Nat.one_le_iff_ne_zero.mpr h)) (Nat.cast_nonneg _) private lemma weight_union_le (s t : Finset (Associates GaussianInt)) : (∑ a ∈ s ∪ t, weight a) ≤ (∑ a ∈ s, weight a) + ∑ a ∈ t, weight a := by have he := sum_union_inter (s₁ := s) (s₂ := t) (f := weight) have hn : 0 ≤ ∑ a ∈ s ∩ t, weight a := sum_nonneg (fun a _ => weight_nonneg a) linarith private lemma weight_biUnion_le (s : Finset ℕ) : (∑ a ∈ s.biUnion rationalPrimeCover, weight a) ≤ ∑ p ∈ s, ∑ a ∈ rationalPrimeCover p, weight a := by induction s using Finset.induction_on with | empty => simp | @insert p s hp ih => rw [biUnion_insert, sum_insert hp] have hu := weight_union_le (rationalPrimeCover p) (s.biUnion rationalPrimeCover) linarith lemma rationalPrimeCover_weight_le {p : ℕ} (hp : p.Prime) : (∑ a ∈ rationalPrimeCover p, weight a) ≤ 10 * (Real.log p / p) := by have hp0 : (0 : ℝ) < p := by exact_mod_cast hp.pos have hp1 : (1 : ℝ) ≤ p := by exact_mod_cast hp.one_le have hl : 0 ≤ Real.log (p : ℝ) := Real.log_nonneg hp1 have hcircle : (∑ a ∈ primeNormClasses p, weight a) ≤ 8 * (Real.log p / p) := by calc _ = (primeNormClasses p).card * (Real.log p / p) := by rw [sum_congr rfl (fun a ha => show weight a = Real.log p / p by rw [weight, (mem_primeNormClasses p a).mp ha])] simp _ ≤ _ := mul_le_mul_of_nonneg_right (by exact_mod_cast primeNormClasses_card_le_eight hp) (div_nonneg hl hp0.le) have hrat : weight (Associates.mk (p : GaussianInt)) ≤ 2 * (Real.log p / p) := by rw [weight, classNorm_natCast, Nat.cast_pow, Real.log_pow] have hpp : (p : ℝ) ≤ (p : ℝ) ^ 2 := by nlinarith calc _ ≤ (2 * Real.log p) / p := div_le_div_of_nonneg_left (by positivity) hp0 hpp _ = _ := by ring have hcover := weight_union_le (primeNormClasses p) {Associates.mk (p : GaussianInt)} simp only [sum_singleton] at hcover unfold rationalPrimeCover linarith /-- Discrete partial summation of the ordinary Chebyshev estimate. Only one harmonic sum occurs, so the result is logarithmic, not squared-logarithmic. -/ lemma rationalPrime_weight_le {Y : ℝ} (hY : 1 ≤ Y) : (∑ p ∈ Nat.primesLE ⌊Y⌋₊, Real.log p / p) ≤ (2 * Real.log 4) * (1 + Real.log Y) := by let n := ⌊Y⌋₊ let c : ℕ → ℝ := fun i => if i.Prime then Real.log i else 0 have hY0 : 0 ≤ Y := zero_le_one.trans hY have hn : 0 < n := Nat.floor_pos.mpr hY have hn0 : (0 : ℝ) < n := by exact_mod_cast hn have htheta (k : ℕ) : (∑ i ∈ range (k + 1), c i) = Chebyshev.theta k := by rw [Chebyshev.theta_eq_sum_primesLE_log] simp [Nat.primesLE, Nat.primesBelow_eq_filter_range, sum_filter, c] have hsum : (∑ p ∈ Nat.primesLE n, Real.log p / p) = ∑ i ∈ range (n + 1), (1 / (i : ℝ)) * c i := by simp only [Nat.primesLE, Nat.primesBelow_eq_filter_range, sum_filter] apply sum_congr rfl intro i _ simp only [c] split_ifs <;> simp [div_eq_mul_inv, mul_comm] have hab : (∑ p ∈ Nat.primesLE n, Real.log p / p) = Chebyshev.theta n / n + ∑ i ∈ range n, Chebyshev.theta i / ((i : ℝ) * (i + 1)) := by rw [hsum] change (∑ i ∈ range (n + 1), (1 / (i : ℝ)) • c i) = _ rw [sum_range_by_parts] simp only [Nat.add_sub_cancel, smul_eq_mul, htheta, Nat.cast_add, Nat.cast_one] rw [sub_eq_add_neg, ← sum_neg_distrib] congr 1 · ring · apply sum_congr rfl intro i _ by_cases hi : i = 0 · simp [hi, Chebyshev.theta] · have hi0 : (i : ℝ) ≠ 0 := by exact_mod_cast hi have hi1 : (i : ℝ) + 1 ≠ 0 := by positivity field_simp [hi0, hi1] <;> ring have hK : 0 ≤ Real.log (4 : ℝ) := Real.log_nonneg (by norm_num) have hhead : Chebyshev.theta n / n ≤ Real.log 4 := (div_le_iff₀ hn0).mpr (Chebyshev.theta_le_log4_mul_x hn0.le) have hterm (i : ℕ) : Chebyshev.theta i / ((i : ℝ) * (i + 1)) ≤ Real.log 4 / (i + 1) := by by_cases hi : i = 0 · simp [hi, hK] · have hi0 : (0 : ℝ) < i := by exact_mod_cast Nat.pos_of_ne_zero hi calc _ ≤ (Real.log 4 * i) / ((i : ℝ) * (i + 1)) := div_le_div_of_nonneg_right (Chebyshev.theta_le_log4_mul_x hi0.le) (by positivity) _ = _ := by have hi1 : (i : ℝ) + 1 ≠ 0 := by positivity field_simp [ne_of_gt hi0, hi1] <;> ring have hhar : (∑ i ∈ range n, Real.log 4 / ((i : ℝ) + 1)) = Real.log 4 * (harmonic n : ℝ) := by simp [harmonic, div_eq_mul_inv, mul_sum] calc _ = Chebyshev.theta n / n + ∑ i ∈ range n, Chebyshev.theta i / ((i : ℝ) * (i + 1)) := hab _ ≤ Real.log 4 + ∑ i ∈ range n, Real.log 4 / (i + 1) := add_le_add hhead (sum_le_sum (fun i _ => hterm i)) _ = Real.log 4 * (1 + (harmonic n : ℝ)) := by rw [hhar]; ring _ ≤ Real.log 4 * (1 + (1 + Real.log Y)) := mul_le_mul_of_nonneg_left (by dsimp [n] linarith [harmonic_floor_le_one_add_log Y hY]) hK _ ≤ _ := by nlinarith [mul_nonneg hK (Real.log_nonneg hY)] /-- Uniform logarithmic Gaussian-prime weight, with an absolute explicit constant. No congruence-class prime theorem is used. -/ theorem primeClassesY_weight_le {Y : ℝ} (hY : 1 ≤ Y) : (∑ a ∈ primeClassesY Y, Real.log (classNorm a) / classNorm a) ≤ (20 * Real.log 4) * (1 + Real.log Y) := by change (∑ a ∈ primeClassesY Y, weight a) ≤ _ calc _ ≤ ∑ a ∈ (Nat.primesLE ⌊Y⌋₊).biUnion rationalPrimeCover, weight a := sum_le_sum_of_subset_of_nonneg (primeClassesY_subset_cover (zero_le_one.trans hY)) (fun a _ _ => weight_nonneg a) _ ≤ ∑ p ∈ Nat.primesLE ⌊Y⌋₊, ∑ a ∈ rationalPrimeCover p, weight a := weight_biUnion_le _ _ ≤ ∑ p ∈ Nat.primesLE ⌊Y⌋₊, 10 * (Real.log p / p) := sum_le_sum (fun p hp => rationalPrimeCover_weight_le (Nat.mem_primesLE.mp hp).2) _ = 10 * ∑ p ∈ Nat.primesLE ⌊Y⌋₊, Real.log p / p := by rw [mul_sum] _ ≤ 10 * ((2 * Real.log 4) * (1 + Real.log Y)) := mul_le_mul_of_nonneg_left (rationalPrime_weight_le hY) (by norm_num) _ = _ := by ring theorem exists_primeClassesY_weight_bound : ∃ C : ℝ, 0 < C ∧ ∀ Y : ℝ, 1 ≤ Y → (∑ a ∈ primeClassesY Y, Real.log (classNorm a) / classNorm a) ≤ C * (1 + Real.log Y) := by refine ⟨20 * Real.log 4, mul_pos (by norm_num) (Real.log_pos (by norm_num)), ?_⟩ exact fun _ hY => primeClassesY_weight_le hY end DistanceCounts.GaussianPrimeWeight end end BodyFile035 -- Source: DistanceCounts/GaussianMassGrowth.lean section BodyFile036 /-! Logarithmic mass growth for the actual nonzero Gaussian associate classes. -/ namespace DistanceCounts.GaussianMass open Finset UniqueFactorizationMonoid open scoped Classical lemma reciprocalMass_nonneg (D : ℝ) : 0 ≤ reciprocalMass D := by exact sum_nonneg fun _ _ => by positivity lemma reciprocalMass_mono {D E : ℝ} (hD : 0 ≤ D) (hDE : D ≤ E) : reciprocalMass D ≤ reciprocalMass E := by exact sum_le_sum_of_subset_of_nonneg (classBall_mono hD hDE) (fun _ _ _ => by positivity) lemma reciprocalMass_double {D : ℝ} (hD : 10000 ≤ D) : reciprocalMass D + 1 / 4 ≤ reciprocalMass (2 * D) := by have hD0 : 0 ≤ D := by linarith have hs : 100 ≤ Real.sqrt D := (Real.le_sqrt (by norm_num) hD0).mpr (by norm_num; exact hD) have hs2 : Real.sqrt (2 * D) ≤ 2 * Real.sqrt D := by apply Real.sqrt_le_iff.mpr constructor · positivity · nlinarith [Real.sq_sqrt hD0] have herr : (Real.pi + 1) * (Real.sqrt (2 * D) + Real.sqrt D + 2) ≤ 20 * Real.sqrt D := by calc _ ≤ 5 * (3 * Real.sqrt D + 2) := by gcongr · linarith [Real.pi_lt_four] · linarith _ ≤ _ := by nlinarith have hmain : D / 2 ≤ (Real.pi / 4) * (2 * D - D) - (Real.pi + 1) * (Real.sqrt (2 * D) + Real.sqrt D + 2) := by have hpi : 3 * D ≤ Real.pi * D := mul_le_mul_of_nonneg_right (le_of_lt Real.pi_gt_three) hD0 have hsq : 80 * Real.sqrt D ≤ D := by nlinarith [Real.sq_sqrt hD0, mul_nonneg (by linarith : 0 ≤ Real.sqrt D) (by linarith : 0 ≤ Real.sqrt D - 80)] nlinarith have hann : (1 / 4 : ℝ) ≤ ∑ a ∈ classBall (2 * D) \ classBall D, 1 / (classNorm a : ℝ) := by have hpos : 0 < 2 * D := by linarith have h := annulus_reciprocal_lower hD0 (by linarith : D ≤ 2 * D) hpos exact (by apply (le_div_iff₀ hpos).mpr nlinarith : (1 / 4 : ℝ) ≤ ((Real.pi / 4) * (2 * D - D) - (Real.pi + 1) * (Real.sqrt (2 * D) + Real.sqrt D + 2)) / (2 * D)).trans h have heq := sum_sdiff (f := fun a => 1 / (classNorm a : ℝ)) (classBall_mono hD0 (show D ≤ 2 * D by linarith)) change (∑ a ∈ classBall D, 1 / (classNorm a : ℝ)) + 1 / 4 ≤ ∑ a ∈ classBall (2 * D), 1 / (classNorm a : ℝ) linarith lemma reciprocalMass_dyadic (n : ℕ) : (n : ℝ) / 4 ≤ reciprocalMass (10000 * (2 : ℝ) ^ n) := by induction n with | zero => simpa using reciprocalMass_nonneg 10000 | succ n ih => have hpow : (1 : ℝ) ≤ 2 ^ n := one_le_pow₀ (by norm_num) have hd := reciprocalMass_double (D := 10000 * (2 : ℝ) ^ n) (by nlinarith) have heq : 2 * (10000 * (2 : ℝ) ^ n) = 10000 * 2 ^ (n + 1) := by ring rw [heq] at hd push_cast linarith lemma reciprocalMass_log_lower {D : ℝ} (hD : 10000 ≤ D) : (Real.log (D / 10000) / Real.log 2 - 1) / 4 ≤ reciprocalMass D := by have hDpos : 0 < D := by linarith have hratio : 1 ≤ D / 10000 := by linarith have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num) let n := ⌊Real.log (D / 10000) / Real.log 2⌋₊ have hn : (n : ℝ) ≤ Real.log (D / 10000) / Real.log 2 := Nat.floor_le (div_nonneg (Real.log_nonneg hratio) hlog2.le) have hn' : Real.log (D / 10000) / Real.log 2 < (n : ℝ) + 1 := Nat.lt_floor_add_one _ have hpow : (2 : ℝ) ^ n ≤ D / 10000 := by apply (Real.log_le_log_iff (by positivity) (by positivity)).mp rw [Real.log_pow] exact (le_div_iff₀ hlog2).mp hn have hcut : 10000 * (2 : ℝ) ^ n ≤ D := by linarith have hm := (reciprocalMass_dyadic n).trans (reciprocalMass_mono (by positivity) hcut) linarith /-- A uniform positive logarithmic lower bound, with explicit finite cutoff. -/ theorem reciprocalMass_log_growth : ∃ c D₀ : ℝ, 0 < c ∧ 0 < D₀ ∧ ∀ D : ℝ, D₀ ≤ D → c * Real.log D ≤ reciprocalMass D := by refine ⟨1 / (8 * Real.log 2), (20000 : ℝ) ^ 2, by positivity, by positivity, ?_⟩ intro D hD have hDlarge : 10000 ≤ D := by nlinarith have hDpos : 0 < D := by nlinarith have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num) have hlogs : 2 * Real.log 20000 ≤ Real.log D := by have hh := Real.log_le_log (by positivity : (0 : ℝ) < 20000 ^ 2) hD simpa only [Real.log_pow, Nat.cast_ofNat] using hh have h20000 : Real.log (20000 : ℝ) = Real.log 10000 + Real.log 2 := by rw [← Real.log_mul (by norm_num : (10000 : ℝ) ≠ 0) (by norm_num : (2 : ℝ) ≠ 0)] norm_num have hbound := reciprocalMass_log_lower hDlarge rw [Real.log_div hDpos.ne' (by norm_num : (10000 : ℝ) ≠ 0)] at hbound have halg : 1 / (8 * Real.log 2) * Real.log D ≤ ((Real.log D - Real.log 10000) / Real.log 2 - 1) / 4 := by apply (mul_le_mul_iff_of_pos_right (show 0 < 8 * Real.log 2 by positivity)).mp field_simp nlinarith exact halg.trans hbound lemma factors_reconstruct {a : Associates GaussianInt} (ha : a ≠ 0) : (∏ p ∈ primeSupport a, p ^ (normalizedFactors a).count p) = a := by rw [primeSupport, ← Finset.prod_multiset_count] exact associated_iff_eq.mp (prod_normalizedFactors ha) lemma support_prod_dvd {a : Associates GaussianInt} (ha : a ≠ 0) : (∏ p ∈ primeSupport a, p) ∣ a := by conv_rhs => rw [← factors_reconstruct ha] apply Finset.prod_dvd_prod_of_dvd intro p hp have hcount : 0 < (normalizedFactors a).count p := Multiset.count_pos.mpr (Multiset.mem_toFinset.mp hp) obtain ⟨k, hk⟩ := Nat.exists_eq_succ_of_ne_zero (Nat.ne_of_gt hcount) rw [hk, pow_succ] exact dvd_mul_left p (p ^ k) lemma support_prod_mem_squarefreeBall {D : ℝ} (hD : 0 ≤ D) {a : Associates GaussianInt} (ha : a ∈ classBall D) : (∏ p ∈ primeSupport a, p) ∈ squarefreeBall D := by obtain ⟨ha0, haD⟩ := (mem_classBall hD a).mp ha apply (mem_squarefreeBall hD _).mpr constructor · exact squarefree_prime_prod _ (fun _ hp => prime_of_mem_primeSupport hp) · have hn := classNorm_le_of_dvd ha0 (support_prod_dvd ha0) exact (by exact_mod_cast hn : (classNorm (∏ p ∈ primeSupport a, p) : ℝ) ≤ classNorm a).trans haD lemma shifted_geometric_sum_le {x : ℝ} (hx : 1 < x) (M : ℕ) : (∑ k : Fin M, (1 / x) ^ (k.val + 1)) ≤ 1 / (x - 1) := by have hx0 : 0 < x := by linarith have hr : 0 ≤ 1 / x := by positivity have hr1 : 1 / x < 1 := (div_lt_one hx0).mpr hx have hg := hasSum_geometric_of_lt_one hr hr1 have hs : (∑ k ∈ range M, (1 / x) ^ k) ≤ (1 - 1 / x)⁻¹ := (hg.summable.sum_le_tsum (range M) (fun _ _ => pow_nonneg hr _)).trans_eq hg.tsum_eq rw [Fin.sum_univ_eq_sum_range (fun k : ℕ => (1 / x) ^ (k + 1)) M] calc (∑ k ∈ range M, (1 / x) ^ (k + 1)) = (1 / x) * ∑ k ∈ range M, (1 / x) ^ k := by rw [mul_sum] exact sum_congr rfl (fun _ _ => pow_succ' _ _) _ ≤ (1 / x) * (1 - 1 / x)⁻¹ := mul_le_mul_of_nonneg_left hs hr _ = 1 / (x - 1) := by have hx1 : x - 1 ≠ 0 := by linarith have hr0 : 1 - 1 / x ≠ 0 := by linarith field_simp /-- Grouping integers by their radical, then summing each finite exponent box, is bounded by the exact geometric Euler weight of that radical. -/ lemma support_fiber_mass_le {D : ℝ} (hD : 0 ≤ D) (S : Finset (Associates GaussianInt)) (hS : ∀ p ∈ S, Prime p) : (∑ a ∈ (classBall D).filter (fun a => primeSupport a = S), 1 / (classNorm a : ℝ)) ≤ 1 / ∏ p ∈ S, ((classNorm p : ℝ) - 1) := by let F := (classBall D).filter (fun a => primeSupport a = S) let M := F.sup (fun a => (normalizedFactors a).card) + 1 let code (a : F) (p : S) : Fin M := ⟨(normalizedFactors a.val).count p.val - 1, by have hc := Multiset.count_le_card p.val (normalizedFactors a.val) have hs := Finset.le_sup (f := fun a => (normalizedFactors a).card) a.property dsimp [M] omega⟩ have ha0 (a : F) : a.val ≠ 0 := ((mem_classBall hD a.val).mp (mem_filter.mp a.property).1).1 have hsupport (a : F) : primeSupport a.val = S := (mem_filter.mp a.property).2 have hexp (a : F) (p : S) : (code a p).val + 1 = (normalizedFactors a.val).count p.val := by have hp : p.val ∈ primeSupport a.val := (hsupport a).symm ▸ p.property have hc : 0 < (normalizedFactors a.val).count p.val := Multiset.count_pos.mpr (Multiset.mem_toFinset.mp hp) dsimp [code] omega have hreconstruct (a : F) : (∏ p : S, p.val ^ ((code a p).val + 1)) = a.val := by simp_rw [hexp a] rw [Finset.prod_coe_sort S (fun p => p ^ (normalizedFactors a.val).count p)] simpa only [hsupport a] using factors_reconstruct (ha0 a) have hinj : Function.Injective code := by intro a b hab apply Subtype.ext rw [← hreconstruct a, ← hreconstruct b, hab] let weight (f : S → Fin M) : ℝ := ∏ p : S, (1 / (classNorm p.val : ℝ)) ^ ((f p).val + 1) have hweight (a : F) : 1 / (classNorm a.val : ℝ) = weight (code a) := by let N : Associates GaussianInt →* ℕ := { toFun := classNorm map_one' := classNorm_one map_mul' := classNorm_mul } have hn : classNorm a.val = ∏ p : S, classNorm p.val ^ ((code a p).val + 1) := by change N a.val = ∏ p : S, N p.val ^ ((code a p).val + 1) simpa only [map_prod, map_pow] using congrArg N (hreconstruct a).symm have hnr : (classNorm a.val : ℝ) = ∏ p : S, (classNorm p.val : ℝ) ^ ((code a p).val + 1) := by exact_mod_cast hn rw [hnr] simp only [weight, one_div, inv_pow, ← Finset.prod_inv_distrib] change (∑ a ∈ F, 1 / (classNorm a : ℝ)) ≤ _ calc (∑ a ∈ F, 1 / (classNorm a : ℝ)) = ∑ a : F, weight (code a) := by rw [← Finset.sum_coe_sort F (fun a => 1 / (classNorm a : ℝ))] exact sum_congr rfl fun a _ => hweight a _ = ∑ f ∈ (univ : Finset F).image code, weight f := (sum_image (fun _ _ _ _ h => hinj h)).symm _ ≤ ∑ f : S → Fin M, weight f := sum_le_univ_sum_of_nonneg (fun f => prod_nonneg (fun _ _ => by positivity)) _ = ∏ p : S, ∑ k : Fin M, (1 / (classNorm p.val : ℝ)) ^ (k.val + 1) := (Fintype.prod_sum (fun (p : S) (k : Fin M) => (1 / (classNorm p.val : ℝ)) ^ (k.val + 1))).symm _ ≤ ∏ p : S, 1 / ((classNorm p.val : ℝ) - 1) := by apply prod_le_prod · intro p _ exact sum_nonneg fun _ _ => by positivity · intro p _ apply shifted_geometric_sum_le have hp := classNorm_prime_two_le (hS p.val p.property) have hp' : (2 : ℝ) ≤ classNorm p.val := by exact_mod_cast hp linarith _ = 1 / ∏ p ∈ S, ((classNorm p : ℝ) - 1) := by simp only [one_div, Finset.prod_inv_distrib] rw [Finset.prod_coe_sort S (fun p => (classNorm p : ℝ) - 1)] /-- The finite Euler product comparison is stronger than the squarefree-times- square comparison: no reciprocal-square summability constant is needed. -/ theorem reciprocalMass_le_squarefreeMass {D : ℝ} (hD : 0 ≤ D) : reciprocalMass D ≤ squarefreeMass D := by have hmap : ∀ a ∈ classBall D, primeSupport a ∈ (squarefreeBall D).image primeSupport := by intro a ha refine mem_image.mpr ⟨∏ p ∈ primeSupport a, p, support_prod_mem_squarefreeBall hD ha, ?_⟩ exact primeSupport_prime_prod _ (fun _ hp => prime_of_mem_primeSupport hp) calc reciprocalMass D = ∑ S ∈ (squarefreeBall D).image primeSupport, ∑ a ∈ (classBall D).filter (fun a => primeSupport a = S), 1 / (classNorm a : ℝ) := (sum_fiberwise_of_maps_to hmap _).symm _ ≤ ∑ S ∈ (squarefreeBall D).image primeSupport, 1 / ∏ p ∈ S, ((classNorm p : ℝ) - 1) := by apply sum_le_sum intro S hS obtain ⟨a, ha, rfl⟩ := mem_image.mp hS exact support_fiber_mass_le hD _ (fun _ hp => prime_of_mem_primeSupport hp) _ = squarefreeMass D := by rw [sum_image] · rfl · intro a ha b hb heq exact primeSupport_injective_squarefree (mem_filter.mp ha).2 (mem_filter.mp hb).2 heq /-- The Selberg denominator grows logarithmically for genuine Gaussian classes. -/ theorem squarefreeMass_log_growth : ∃ c D₀ : ℝ, 0 < c ∧ 0 < D₀ ∧ ∀ D : ℝ, D₀ ≤ D → c * Real.log D ≤ squarefreeMass D := by obtain ⟨c, D₀, hc, hD₀, h⟩ := reciprocalMass_log_growth exact ⟨c, D₀, hc, hD₀, fun D hD => (h D hD).trans (reciprocalMass_le_squarefreeMass (hD₀.le.trans hD))⟩ end DistanceCounts.GaussianMass end BodyFile036 -- Source: DistanceCounts/GaussianSmoothPart.lean section BodyFile037 /-! The actual Gaussian small-prime factor, its first moment, and the original manuscript cutoffs. All populations consist of nonzero Gaussian vectors. -/ noncomputable section namespace DistanceCounts.GaussianSmoothPart open Finset Filter GaussianMass GaussianPrimeWeight open scoped Classical Topology /-- The finite multiplicity in the unique factorization of the actual class. -/ def valuation (p : Associates GaussianInt) (z : GaussianInt) : ℕ := p.count (Associates.mk z).factors /-- Both split conjugate classes and the ramified class retain their actual multiplicities; this is a factor of `Associates.mk z`, not a norm surrogate. -/ def smallPartY (Y : ℝ) (z : GaussianInt) : Associates GaussianInt := ∏ p ∈ primeClassesY Y, p ^ valuation p z private def normHom : Associates GaussianInt →* ℕ where toFun := classNorm map_one' := classNorm_one map_mul' := classNorm_mul lemma classNorm_pow (a : Associates GaussianInt) (k : ℕ) : classNorm (a ^ k) = classNorm a ^ k := normHom.map_pow a k lemma prime_of_mem {Y : ℝ} {p : Associates GaussianInt} (hp : p ∈ primeClassesY Y) : Prime p := (mem_filter.mp hp).2 lemma smallPartY_ne_zero (Y : ℝ) (z : GaussianInt) : smallPartY Y z ≠ 0 := by apply prod_ne_zero_iff.mpr intro p hp exact pow_ne_zero _ (prime_of_mem hp).ne_zero lemma log_smallPartY_nonneg (Y : ℝ) (z : GaussianInt) : 0 ≤ Real.log (classNorm (smallPartY Y z)) := by apply Real.log_nonneg exact_mod_cast Nat.one_le_iff_ne_zero.mpr ((classNorm_eq_zero _).not.mpr (smallPartY_ne_zero Y z)) /-- The logarithm of the genuine product is exactly the weighted valuation sum. -/ theorem log_smallPartY (Y : ℝ) (z : GaussianInt) : Real.log (classNorm (smallPartY Y z)) = ∑ p ∈ primeClassesY Y, (valuation p z : ℝ) * Real.log (classNorm p) := by have hn : classNorm (smallPartY Y z) = ∏ p ∈ primeClassesY Y, classNorm p ^ valuation p z := by change normHom (∏ p ∈ primeClassesY Y, p ^ valuation p z) = ∏ p ∈ primeClassesY Y, normHom p ^ valuation p z simp only [map_prod, map_pow] rw [hn, Nat.cast_prod, Real.log_prod] · apply sum_congr rfl intro p _ rw [Nat.cast_pow, Real.log_pow] · intro p hp rw [Nat.cast_pow] exact pow_ne_zero _ (by exact_mod_cast (ne_of_gt ((classNorm_pos p).mpr (prime_of_mem hp).ne_zero))) lemma pow_dvd_iff_le_valuation {p : Associates GaussianInt} (hp : Prime p) {z : GaussianInt} (hz : z ≠ 0) (k : ℕ) : p ^ k ∣ Associates.mk z ↔ k ≤ valuation p z := by exact Associates.prime_pow_dvd_iff_le (Associates.mk_ne_zero.mpr hz) hp.irreducible /-- Exact finite layer cake, with any upper bound on the actual multiplicity. -/ lemma valuation_layer_cake {p : Associates GaussianInt} (hp : Prime p) {z : GaussianInt} (hz : z ≠ 0) {M : ℕ} (hM : valuation p z ≤ M) : (valuation p z : ℝ) = ∑ k ∈ range M, if p ^ (k + 1) ∣ Associates.mk z then (1 : ℝ) else 0 := by simp_rw [pow_dvd_iff_le_valuation hp hz] have he : (range M).filter (fun k => k + 1 ≤ valuation p z) = range (valuation p z) := by ext k simp only [mem_filter, mem_range] omega rw [← sum_filter, he] simp /-- Transfer an actual associate divisor back to its Gaussian ideal lattice. -/ lemma divisor_population_le {a : Associates GaussianInt} (ha : a ≠ 0) {R : ℝ} (hR : 0 ≤ R) : (((representatives (R ^ 2)).filter (fun z => a ∣ Associates.mk z)).card : ℝ) ≤ 9 * Real.pi * R ^ 2 / classNorm a := by obtain ⟨d, rfl⟩ := Associates.mk_surjective a have hd : d ≠ 0 := Associates.mk_ne_zero.mp ha have he : (representatives (R ^ 2)).filter (fun z => Associates.mk d ∣ Associates.mk z) = (GaussianDivisibility.divisorDisk d R).erase 0 := by ext z simp only [representatives, Real.sqrt_sq hR, mem_filter, mem_erase, mem_gaussianDisk, GaussianDivisibility.mem_divisorDisk, Associates.mk_dvd_mk] tauto rw [he] exact GaussianDivisibility.divisorDisk_erase_zero_card_upper d hd hR /-- Sum of the multiplicity of one genuine Gaussian prime over the disk. The finite layer cake needs no truncation hypothesis on its prime powers. -/ theorem valuation_sum_le {p : Associates GaussianInt} (hp : Prime p) {R : ℝ} (hR : 0 ≤ R) : (∑ z ∈ representatives (R ^ 2), (valuation p z : ℝ)) ≤ (18 * Real.pi) * R ^ 2 / classNorm p := by let A := representatives (R ^ 2) let M := A.sup (valuation p) have hN : (2 : ℝ) ≤ classNorm p := by exact_mod_cast classNorm_prime_two_le hp have hN0 : (0 : ℝ) < classNorm p := by linarith have hgeom : (∑ k ∈ range M, (1 / (classNorm p : ℝ)) ^ (k + 1)) ≤ 2 / classNorm p := by have hg := shifted_geometric_sum_le (x := (classNorm p : ℝ)) (by linarith) M rw [Fin.sum_univ_eq_sum_range (fun k : ℕ => (1 / (classNorm p : ℝ)) ^ (k + 1)) M] at hg apply hg.trans apply (div_le_div_iff₀ (by linarith : (0 : ℝ) < classNorm p - 1) hN0).mpr linarith calc (∑ z ∈ A, (valuation p z : ℝ)) = ∑ z ∈ A, ∑ k ∈ range M, if p ^ (k + 1) ∣ Associates.mk z then (1 : ℝ) else 0 := by apply sum_congr rfl intro z hz exact valuation_layer_cake hp ((mem_representatives (sq_nonneg R) z).mp hz).1 (Finset.le_sup (f := valuation p) hz) _ = ∑ k ∈ range M, (((representatives (R ^ 2)).filter (fun z => p ^ (k + 1) ∣ Associates.mk z)).card : ℝ) := by rw [sum_comm] apply sum_congr rfl intro k _ simp only [← sum_filter, sum_const, nsmul_eq_mul, mul_one, A] _ ≤ ∑ k ∈ range M, 9 * Real.pi * R ^ 2 / (classNorm p : ℝ) ^ (k + 1) := by apply sum_le_sum intro k _ simpa only [classNorm_pow, Nat.cast_pow] using divisor_population_le (pow_ne_zero (k + 1) hp.ne_zero) hR _ = (9 * Real.pi * R ^ 2) * ∑ k ∈ range M, (1 / (classNorm p : ℝ)) ^ (k + 1) := by simp only [mul_sum, div_pow, one_pow, div_eq_mul_inv, one_mul, inv_pow] _ ≤ (9 * Real.pi * R ^ 2) * (2 / classNorm p) := mul_le_mul_of_nonneg_left hgeom (by positivity) _ = _ := by ring /-- Absolute first moment at every real radius, using the proved prime weight bound rather than a smoothness or independence assumption. -/ theorem log_smallPartY_sum_le {R Y : ℝ} (hR : 0 ≤ R) (hY : 1 ≤ Y) : (∑ z ∈ representatives (R ^ 2), Real.log (classNorm (smallPartY Y z))) ≤ (360 * Real.pi * Real.log 4) * R ^ 2 * (1 + Real.log Y) := by simp_rw [log_smallPartY] rw [sum_comm] calc _ = ∑ p ∈ primeClassesY Y, (∑ z ∈ representatives (R ^ 2), (valuation p z : ℝ)) * Real.log (classNorm p) := by simp only [sum_mul] _ ≤ ∑ p ∈ primeClassesY Y, ((18 * Real.pi) * R ^ 2 / classNorm p) * Real.log (classNorm p) := by apply sum_le_sum intro p hp apply mul_le_mul_of_nonneg_right (valuation_sum_le (prime_of_mem hp) hR) apply Real.log_nonneg exact_mod_cast (le_trans (by decide : 1 ≤ 2) (classNorm_prime_two_le (prime_of_mem hp))) _ = ((18 * Real.pi) * R ^ 2) * ∑ p ∈ primeClassesY Y, Real.log (classNorm p) / classNorm p := by rw [mul_sum] apply sum_congr rfl intro p _ ring _ ≤ ((18 * Real.pi) * R ^ 2) * ((20 * Real.log 4) * (1 + Real.log Y)) := mul_le_mul_of_nonneg_left (primeClassesY_weight_le hY) (by positivity) _ = _ := by ring theorem exists_log_smallPartY_sum_bound : ∃ C : ℝ, 0 < C ∧ ∀ R : ℝ, 0 ≤ R → ∀ Y : ℝ, 1 ≤ Y → (∑ z ∈ representatives (R ^ 2), Real.log (classNorm (smallPartY Y z))) ≤ C * R ^ 2 * (1 + Real.log Y) := by refine ⟨360 * Real.pi * Real.log 4, ?_, fun _ hR _ hY => log_smallPartY_sum_le hR hY⟩ exact mul_pos (mul_pos (by norm_num) Real.pi_pos) (Real.log_pos (by norm_num)) /-- Vectors whose genuine small-prime factor is larger than `S`. -/ def exceptional (R Y S : ℝ) : Finset GaussianInt := (representatives (R ^ 2)).filter (fun z => S < (classNorm (smallPartY Y z) : ℝ)) /-- Deterministic Markov inequality, before specializing either cutoff. -/ theorem exceptional_card_le {R Y S : ℝ} (hR : 0 ≤ R) (hY : 1 ≤ Y) (hS : 1 < S) : ((exceptional R Y S).card : ℝ) ≤ (360 * Real.pi * Real.log 4) * R ^ 2 * (1 + Real.log Y) / Real.log S := by apply (le_div_iff₀ (Real.log_pos hS)).mpr calc _ = ∑ _z ∈ exceptional R Y S, Real.log S := by simp _ ≤ ∑ z ∈ exceptional R Y S, Real.log (classNorm (smallPartY Y z)) := by apply sum_le_sum intro z hz exact (Real.log_lt_log (zero_lt_one.trans hS) (mem_filter.mp hz).2).le _ ≤ ∑ z ∈ representatives (R ^ 2), Real.log (classNorm (smallPartY Y z)) := sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun z _ _ => log_smallPartY_nonneg Y z) _ ≤ _ := log_smallPartY_sum_le hR hY /-- The manuscript's original small-prime scale, without changing its exponent. -/ def manuscriptY (R κ : ℝ) : ℝ := Real.exp ((Real.log R) ^ κ) /-- The manuscript's original smooth-part cutoff. -/ def manuscriptS (R κ : ℝ) : ℝ := Real.exp ((Real.log R) ^ (2 * κ)) /-- Vanishing exceptional density through all real radii, at exactly `Y = exp((log R)^κ)` and `S = exp((log R)^(2κ))`. -/ theorem tendsto_exceptional_card {κ : ℝ} (hκ : 0 < κ) : Tendsto (fun R : ℝ => ((exceptional R (manuscriptY R κ) (manuscriptS R κ)).card : ℝ) / R ^ 2) atTop (𝓝 0) := by let C : ℝ := 360 * Real.pi * Real.log 4 let t : ℝ → ℝ := fun R => (Real.log R) ^ κ have ht : Tendsto t atTop atTop := (tendsto_rpow_atTop hκ).comp Real.tendsto_log_atTop have hi : Tendsto (fun R => (t R)⁻¹) atTop (𝓝 (0 : ℝ)) := tendsto_inv_atTop_zero.comp ht have hb : Tendsto (fun R => C * ((t R)⁻¹ ^ 2 + (t R)⁻¹)) atTop (𝓝 (0 : ℝ)) := by simpa using ((hi.pow 2).add hi).const_mul C apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds hb · exact Eventually.of_forall fun R => div_nonneg (Nat.cast_nonneg _) (sq_nonneg R) · filter_upwards [eventually_gt_atTop (1 : ℝ)] with R hR have hR0 : 0 < R := zero_lt_one.trans hR have hl : 0 < Real.log R := Real.log_pos hR have ht0 : 0 < t R := Real.rpow_pos_of_pos hl κ have hY : 1 ≤ manuscriptY R κ := Real.one_le_exp_iff.mpr ht0.le have hpower : (Real.log R) ^ (2 * κ) = (t R) ^ 2 := by rw [mul_comm (2 : ℝ) κ, Real.rpow_mul hl.le, Real.rpow_two] have hS : 1 < manuscriptS R κ := by apply Real.one_lt_exp_iff.mpr exact Real.rpow_pos_of_pos hl _ have hc := exceptional_card_le hR0.le hY hS have hlogY : Real.log (manuscriptY R κ) = t R := Real.log_exp _ have hlogS : Real.log (manuscriptS R κ) = (t R) ^ 2 := by rw [manuscriptS, Real.log_exp, hpower] rw [hlogY, hlogS] at hc calc _ ≤ (C * R ^ 2 * (1 + t R) / (t R) ^ 2) / R ^ 2 := div_le_div_of_nonneg_right hc (sq_nonneg R) _ = C * ((t R)⁻¹ ^ 2 + (t R)⁻¹) := by field_simp [ne_of_gt hR0, ne_of_gt ht0] <;> ring end DistanceCounts.GaussianSmoothPart end end BodyFile037 -- Source: DistanceCounts/SmallFlipLattice.lean section BodyFile038 /-! Finite reciprocal estimates for the four small-flip lattice directions. -/ noncomputable section namespace DistanceCounts.SmallFlipLattice open GaussianDivisibility private lemma sum_le_cover {α β : Type*} [DecidableEq α] [DecidableEq β] (A : Finset α) (B : Finset β) (g : β → α) (f : α → ℝ) (hf : ∀ x, 0 ≤ f x) (h : A ⊆ B.image g) : ∑ x ∈ A, f x ≤ ∑ y ∈ B, f (g y) := by exact (Finset.sum_le_sum_of_subset_of_nonneg h (fun x _ _ => hf x)).trans (Finset.sum_image_le_of_nonneg (fun x _ => hf x)) private lemma sum_biUnion_upper {α β : Type*} [DecidableEq α] [DecidableEq β] (I : Finset α) (A : α → Finset β) (f : β → ℝ) (hf : ∀ x, 0 ≤ f x) : ∑ x ∈ I.biUnion A, f x ≤ ∑ i ∈ I, ∑ x ∈ A i, f x := by classical have h := sum_le_cover (I.biUnion A) (I.sigma A) (fun p => p.2) f hf (by intro x hx obtain ⟨i, hi, hx⟩ := Finset.mem_biUnion.mp hx exact Finset.mem_image.mpr ⟨⟨i, x⟩, Finset.mem_sigma.mpr ⟨hi, hx⟩, rfl⟩) simpa only [Finset.sum_sigma] using h /-- A telescoping majorant, valid even at the origin of the longitudinal axis. -/ lemma reciprocal_quadratic_majorant {a b : ℝ} (ha : 0 ≤ a) (hb : 1 ≤ b) : 1 / (a ^ 2 + b ^ 2) ≤ 4 * (1 / (a + b) - 1 / (a + b + 1)) := by have hb0 : 0 < b := by linarith have hab : 0 < a + b := by positivity have hab1 : 0 < a + b + 1 := by positivity have hd : 0 < a ^ 2 + b ^ 2 := by positivity have hpoly : (a + b) * (a + b + 1) ≤ 4 * (a ^ 2 + b ^ 2) := by nlinarith [sq_nonneg (a - b), mul_nonneg hab.le (by linarith : 0 ≤ a + b - 1)] have he : 4 * (1 / (a + b) - 1 / (a + b + 1)) = 4 / ((a + b) * (a + b + 1)) := by field_simp [ne_of_gt hab, ne_of_gt hab1] <;> ring rw [he] exact (div_le_div_iff₀ hd (mul_pos hab hab1)).mpr (by simpa using hpoly) private lemma sum_reciprocal_quadratic_nat (M : ℕ) {b : ℝ} (hb : 1 ≤ b) : ∑ a ∈ Finset.range M, 1 / ((a : ℝ) ^ 2 + b ^ 2) ≤ 4 / b := by have ht : ∑ a ∈ Finset.range M, (1 / ((a : ℝ) + b) - 1 / ((a : ℝ) + b + 1)) = 1 / b - 1 / ((M : ℝ) + b) := by induction M with | zero => simp | succ M ih => rw [Finset.sum_range_succ, ih] push_cast ring calc _ ≤ ∑ a ∈ Finset.range M, 4 * (1 / ((a : ℝ) + b) - 1 / ((a : ℝ) + b + 1)) := Finset.sum_le_sum (fun a _ => reciprocal_quadratic_majorant (Nat.cast_nonneg a) hb) _ = 4 * (1 / b - 1 / ((M : ℝ) + b)) := by rw [← Finset.mul_sum, ht] _ ≤ 4 / b := by have : 0 ≤ 1 / ((M : ℝ) + b) := by positivity simp only [div_eq_mul_inv, one_mul] at * linarith private def signed (e : Bool) (n : ℕ) : ℤ := if e then n else -(n : ℤ) private lemma exists_signed (z : ℤ) : ∃ e, signed e z.natAbs = z := by by_cases hz : 0 ≤ z · exact ⟨true, by simpa [signed, Int.natCast_natAbs, abs_of_nonneg hz]⟩ · exact ⟨false, by simp [signed, Int.natCast_natAbs, abs_of_neg (lt_of_not_ge hz)]⟩ private lemma signed_sq (e : Bool) (n : ℕ) : ((signed e n : ℤ) : ℝ) ^ 2 = (n : ℝ) ^ 2 := by cases e <;> simp [signed] private def integerRange (M : ℕ) : Finset ℤ := ((Finset.univ : Finset Bool) ×ˢ Finset.range (M + 1)).image (fun p => signed p.1 p.2) private lemma mem_integerRange {M : ℕ} {z : ℤ} (hz : z.natAbs ≤ M) : z ∈ integerRange M := by obtain ⟨e, he⟩ := exists_signed z exact Finset.mem_image.mpr ⟨(e, z.natAbs), Finset.mem_product.mpr ⟨Finset.mem_univ _, Finset.mem_range.mpr (by omega)⟩, he⟩ /-- The finite lattice-line bound. The longitudinal interval may be arbitrarily long. -/ lemma integer_line_reciprocal_upper (M : ℕ) {b : ℤ} (hb : b ≠ 0) : ∑ a ∈ integerRange M, 1 / ((a : ℝ) ^ 2 + (b : ℝ) ^ 2) ≤ 8 / (b.natAbs : ℝ) := by have hb1 : (1 : ℝ) ≤ b.natAbs := by exact_mod_cast Nat.succ_le_of_lt (Int.natAbs_pos.mpr hb) have hbsq : (b : ℝ) ^ 2 = (b.natAbs : ℝ) ^ 2 := by have h : (b.natAbs : ℤ) ^ 2 = b ^ 2 := by rw [Int.natCast_natAbs, sq_abs] simpa only [Int.cast_pow, Int.cast_natCast] using congrArg (fun x : ℤ => (x : ℝ)) h.symm have h := sum_le_cover (integerRange M) ((Finset.univ : Finset Bool) ×ˢ Finset.range (M + 1)) (fun p => signed p.1 p.2) (fun a => 1 / ((a : ℝ) ^ 2 + (b : ℝ) ^ 2)) (fun a => by positivity) (by intro x hx; exact hx) simp only [Finset.sum_product, signed_sq, hbsq] at h have hs := sum_reciprocal_quadratic_nat (M + 1) hb1 simpa only [hbsq] using h.trans (show (∑ e : Bool, ∑ a ∈ Finset.range (M + 1), 1 / ((a : ℝ) ^ 2 + (b.natAbs : ℝ) ^ 2)) ≤ 8 / (b.natAbs : ℝ) by simp only [Fintype.sum_bool] linarith [show (8 : ℝ) / b.natAbs = 2 * (4 / b.natAbs) by ring]) private def multiples (q K : ℕ) : Finset ℤ := ((Finset.univ : Finset Bool) ×ˢ Finset.Icc 1 K).image (fun p => signed p.1 (q * p.2)) private lemma mem_multiples {q K : ℕ} (hq : 1 ≤ q) {b : ℤ} (hb : b ≠ 0) (hqb : (q : ℤ) ∣ b) (hK : b.natAbs ≤ K) : b ∈ multiples q K := by obtain ⟨k, hk⟩ := hqb have hk0 : k ≠ 0 := by intro h; simp [h] at hk; exact hb hk have ha : b.natAbs = q * k.natAbs := by rw [hk, Int.natAbs_mul, Int.natAbs_natCast] have hkK : k.natAbs ≤ K := by calc k.natAbs = 1 * k.natAbs := by simp _ ≤ q * k.natAbs := Nat.mul_le_mul_right _ hq _ ≤ K := ha ▸ hK obtain ⟨e, he⟩ := exists_signed b apply Finset.mem_image.mpr refine ⟨(e, k.natAbs), Finset.mem_product.mpr ⟨Finset.mem_univ _, Finset.mem_Icc.mpr ⟨Int.natAbs_pos.mpr hk0, hkK⟩⟩, ?_⟩ simpa only [← ha] using he /-- A finite rectangular enlargement of the nonzero transverse multiples. -/ lemma reciprocal_rectangle_upper (q M K : ℕ) (hq : 1 ≤ q) : ∑ p ∈ integerRange M ×ˢ multiples q K, 1 / ((p.1 : ℝ) ^ 2 + (p.2 : ℝ) ^ 2) ≤ 16 / (q : ℝ) * (harmonic K : ℝ) := by classical have hq0 : (0 : ℝ) < q := by exact_mod_cast (show 0 < q by omega) rw [Finset.sum_product, Finset.sum_comm] calc _ ≤ ∑ p ∈ (Finset.univ : Finset Bool) ×ˢ Finset.Icc 1 K, ∑ a ∈ integerRange M, 1 / ((a : ℝ) ^ 2 + (signed p.1 (q * p.2) : ℝ) ^ 2) := by apply sum_le_cover _ _ _ _ (fun b => Finset.sum_nonneg (fun a _ => by positivity)) intro b hb exact hb _ ≤ ∑ p ∈ (Finset.univ : Finset Bool) ×ˢ Finset.Icc 1 K, 8 / ((q : ℝ) * (p.2 : ℝ)) := by apply Finset.sum_le_sum intro p hp have hk := (Finset.mem_Icc.mp (Finset.mem_product.mp hp).2).1 have hn : signed p.1 (q * p.2) ≠ 0 := by cases h : p.1 <;> simp [signed, h, Nat.ne_of_gt (show 0 < q by omega), Nat.ne_of_gt (show 0 < p.2 by omega)] have hs := integer_line_reciprocal_upper M hn cases he : p.1 <;> simpa [signed, he, Nat.cast_mul] using hs _ = 16 / (q : ℝ) * (harmonic K : ℝ) := by simp only [Finset.sum_product, Fintype.sum_bool] simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast] simp_rw [div_mul_eq_div_mul_one_div, one_div] simp only [← Finset.mul_sum] ring /-- Longitudinal and transverse coordinates for the horizontal, vertical, and the two diagonal directions, respectively. -/ def coordinates (i : Fin 4) (z : GaussianInt) : ℤ × ℤ := ![(z.re, z.im), (z.im, z.re), (z.re + z.im, z.re - z.im), (z.re - z.im, z.re + z.im)] i /-- Actual vectors; in particular the transverse coordinate zero is excluded. -/ def directionVectors (i : Fin 4) (q : ℕ) (S : ℝ) : Finset GaussianInt := by classical exact ((gaussianDisk 0 (Real.sqrt S)).erase 0).filter (fun z => (q : ℤ) ∣ (coordinates i z).2 ∧ (coordinates i z).2 ≠ 0) /-- The union of all four genuine small-flip directions. -/ def smallFlipVectors (q : ℕ) (S : ℝ) : Finset GaussianInt := by classical exact Finset.univ.biUnion (fun i : Fin 4 => directionVectors i q S) lemma mem_directionVectors (i : Fin 4) (q : ℕ) (S : ℝ) (z : GaussianInt) : z ∈ directionVectors i q S ↔ z ≠ 0 ∧ ‖(z : ℂ)‖ ≤ Real.sqrt S ∧ (q : ℤ) ∣ (coordinates i z).2 ∧ (coordinates i z).2 ≠ 0 := by classical simp [directionVectors, mem_gaussianDisk, and_assoc] lemma mem_smallFlipVectors (q : ℕ) (S : ℝ) (z : GaussianInt) : z ∈ smallFlipVectors q S ↔ z ≠ 0 ∧ ‖(z : ℂ)‖ ≤ Real.sqrt S ∧ (((q : ℤ) ∣ z.im ∧ z.im ≠ 0) ∨ ((q : ℤ) ∣ z.re ∧ z.re ≠ 0) ∨ ((q : ℤ) ∣ z.re - z.im ∧ z.re - z.im ≠ 0) ∨ ((q : ℤ) ∣ z.re + z.im ∧ z.re + z.im ≠ 0)) := by classical simp only [smallFlipVectors, Finset.mem_biUnion, Finset.mem_univ, true_and, mem_directionVectors] simp [Fin.exists_fin_succ, coordinates, and_or_left, and_assoc] private lemma coordinates_injective (i : Fin 4) : Function.Injective (coordinates i) := by intro z w h have ha := congrArg Prod.fst h have hb := congrArg Prod.snd h apply Zsqrtd.ext <;> fin_cases i <;> simp [coordinates] at ha hb ⊢ <;> omega private lemma normMass_coordinates (z : GaussianInt) : normMass z = (z.re : ℝ) ^ 2 + (z.im : ℝ) ^ 2 := by have hn := congrArg (fun n : ℤ => (n : ℝ)) (GaussianInt.abs_natCast_norm z) simpa [normMass, Zsqrtd.norm, pow_two] using hn private lemma coordinates_sq_upper (i : Fin 4) (z : GaussianInt) : ((coordinates i z).1 : ℝ) ^ 2 + ((coordinates i z).2 : ℝ) ^ 2 ≤ 2 * normMass z := by rw [normMass_coordinates] fin_cases i <;> simp [coordinates] <;> nlinarith [sq_nonneg (z.re : ℝ), sq_nonneg (z.im : ℝ)] private lemma coordinates_abs_le {S : ℝ} (hS : 1 ≤ S) (i : Fin 4) (z : GaussianInt) (hz : ‖(z : ℂ)‖ ≤ Real.sqrt S) : ((coordinates i z).1.natAbs : ℝ) ≤ 2 * S ∧ ((coordinates i z).2.natAbs : ℝ) ≤ 2 * S := by have hN : normMass z ≤ S := by rw [normMass_eq_sq_norm] have h := (sq_le_sq₀ (norm_nonneg (z : ℂ)) (Real.sqrt_nonneg S)).mpr hz simpa only [Real.sq_sqrt (show 0 ≤ S by linarith)] using h have hcoord := (coordinates_sq_upper i z).trans (mul_le_mul_of_nonneg_left hN (by norm_num)) have hsq (a : ℤ) : (a.natAbs : ℝ) ^ 2 = (a : ℝ) ^ 2 := by have h : (a.natAbs : ℤ) ^ 2 = a ^ 2 := by rw [Int.natCast_natAbs, sq_abs] simpa only [Int.cast_pow, Int.cast_natCast] using congrArg (fun x : ℤ => (x : ℝ)) h have h₁ := Nat.cast_nonneg (α := ℝ) (coordinates i z).1.natAbs have h₂ := Nat.cast_nonneg (α := ℝ) (coordinates i z).2.natAbs rw [← hsq (coordinates i z).1, ← hsq (coordinates i z).2] at hcoord constructor <;> nlinarith [sq_nonneg ((coordinates i z).1.natAbs : ℝ), sq_nonneg ((coordinates i z).2.natAbs : ℝ), sq_nonneg (((coordinates i z).1.natAbs : ℝ) - 1), sq_nonneg (((coordinates i z).2.natAbs : ℝ) - 1)] /-- Each of the four actual directions has reciprocal mass at most `64 (1 + log S) / q`. The diagonal image is enlarged without any parity premise. -/ theorem directionVectors_reciprocal_upper (i : Fin 4) (q : ℕ) (hq : 1 ≤ q) {S : ℝ} (hS : 1 ≤ S) : ∑ z ∈ directionVectors i q S, 1 / normMass z ≤ 64 * (1 + Real.log S) / (q : ℝ) := by classical let M : ℕ := ⌊2 * S⌋₊ have hq0 : (0 : ℝ) < q := by exact_mod_cast (show 0 < q by omega) have hmaps : (directionVectors i q S).image (coordinates i) ⊆ integerRange M ×ˢ multiples q M := by intro p hp obtain ⟨z, hz, rfl⟩ := Finset.mem_image.mp hp obtain ⟨hz0, hzR, hqz, hzt⟩ := (mem_directionVectors i q S z).mp hz obtain ⟨ha, hb⟩ := coordinates_abs_le hS i z hzR exact Finset.mem_product.mpr ⟨mem_integerRange (Nat.le_floor ha), mem_multiples hq hzt hqz (Nat.le_floor hb)⟩ have hrec : ∑ z ∈ directionVectors i q S, 1 / normMass z ≤ 2 * (∑ p ∈ integerRange M ×ˢ multiples q M, 1 / ((p.1 : ℝ) ^ 2 + (p.2 : ℝ) ^ 2)) := by calc _ ≤ ∑ z ∈ directionVectors i q S, 2 * (1 / (((coordinates i z).1 : ℝ) ^ 2 + ((coordinates i z).2 : ℝ) ^ 2)) := by apply Finset.sum_le_sum intro z hz obtain ⟨hz0, _, _, hzt⟩ := (mem_directionVectors i q S z).mp hz have hN : 0 < normMass z := lt_of_lt_of_le zero_lt_one (one_le_normMass hz0) have ht : (0 : ℝ) < ((coordinates i z).1 : ℝ) ^ 2 + ((coordinates i z).2 : ℝ) ^ 2 := by have hcast : ((coordinates i z).2 : ℝ) ≠ 0 := by exact_mod_cast hzt positivity have hh := coordinates_sq_upper i z rw [mul_one_div] exact (div_le_div_iff₀ hN ht).mpr (by simpa using hh) _ = 2 * (∑ p ∈ (directionVectors i q S).image (coordinates i), 1 / ((p.1 : ℝ) ^ 2 + (p.2 : ℝ) ^ 2)) := by rw [Finset.sum_image (fun x _ y _ h => coordinates_injective i h), Finset.mul_sum] _ ≤ _ := mul_le_mul_of_nonneg_left (Finset.sum_le_sum_of_subset_of_nonneg hmaps (fun p _ _ => by positivity)) (by norm_num) have hh : (harmonic M : ℝ) ≤ 2 * (1 + Real.log S) := by have h := harmonic_floor_le_one_add_log (2 * S) (by linarith) have hlog := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) have hlogS := Real.log_nonneg hS rw [Real.log_mul (by norm_num : (2 : ℝ) ≠ 0) (by linarith : S ≠ 0)] at h dsimp [M] linarith calc _ ≤ 2 * (16 / (q : ℝ) * (harmonic M : ℝ)) := hrec.trans (mul_le_mul_of_nonneg_left (reciprocal_rectangle_upper q M M hq) (by norm_num)) _ ≤ 2 * (16 / (q : ℝ) * (2 * (1 + Real.log S))) := mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left hh (by positivity)) (by norm_num) _ = _ := by ring /-- Quantitative reciprocal mass of the four-direction union, counting a vector once. -/ theorem smallFlipVectors_reciprocal_upper (q : ℕ) (hq : 1 ≤ q) {S : ℝ} (hS : 1 ≤ S) : ∑ z ∈ smallFlipVectors q S, 1 / normMass z ≤ 256 * (1 + Real.log S) / (q : ℝ) := by classical calc _ ≤ ∑ i : Fin 4, ∑ z ∈ directionVectors i q S, 1 / normMass z := sum_biUnion_upper _ _ _ (fun z => by unfold normMass; positivity) _ ≤ ∑ _i : Fin 4, 64 * (1 + Real.log S) / (q : ℝ) := Finset.sum_le_sum (fun i _ => directionVectors_reciprocal_upper i q hq hS) _ = _ := by simp; ring /-- Actual nonzero Gaussian vectors in radius `R` divisible by a small-flip vector. -/ def smallFlipDivisibleVectors (q : ℕ) (S R : ℝ) : Finset GaussianInt := by classical exact (smallFlipVectors q S).biUnion (fun v => (divisorDisk v R).erase 0) lemma mem_smallFlipDivisibleVectors (q : ℕ) (S R : ℝ) (z : GaussianInt) : z ∈ smallFlipDivisibleVectors q S R ↔ z ≠ 0 ∧ ‖(z : ℂ)‖ ≤ R ∧ ∃ v ∈ smallFlipVectors q S, v ∣ z := by classical simp only [smallFlipDivisibleVectors, Finset.mem_biUnion, Finset.mem_erase, mem_divisorDisk, dist_zero_right] aesop /-- The small-flip union count; no independence or equidistribution input is used. -/ theorem smallFlipDivisibleVectors_card_upper (q : ℕ) (hq : 1 ≤ q) {S R : ℝ} (hS : 1 ≤ S) (hR : 0 ≤ R) : ((smallFlipDivisibleVectors q S R).card : ℝ) ≤ (2304 * Real.pi) * R ^ 2 * (1 + Real.log S) / (q : ℝ) := by classical calc _ ≤ ∑ v ∈ smallFlipVectors q S, (((divisorDisk v R).erase 0).card : ℝ) := by exact_mod_cast (Finset.card_biUnion_le (s := smallFlipVectors q S) (t := fun v => (divisorDisk v R).erase 0)) _ ≤ ∑ v ∈ smallFlipVectors q S, 9 * Real.pi * R ^ 2 / normMass v := by apply Finset.sum_le_sum intro v hv exact divisorDisk_erase_zero_card_upper v ((mem_smallFlipVectors q S v).mp hv).1 hR _ = (9 * Real.pi * R ^ 2) * (∑ v ∈ smallFlipVectors q S, 1 / normMass v) := by rw [Finset.mul_sum] apply Finset.sum_congr rfl intro v hv ring _ ≤ (9 * Real.pi * R ^ 2) * (256 * (1 + Real.log S) / (q : ℝ)) := mul_le_mul_of_nonneg_left (smallFlipVectors_reciprocal_upper q hq hS) (by positivity) _ = _ := by ring end DistanceCounts.SmallFlipLattice end end BodyFile038 -- Source: DistanceCounts/GaussianMassExclusions.lean section BodyFile039 /-! Removing finitely many genuine Gaussian prime classes from squarefree mass. -/ noncomputable section namespace DistanceCounts.GaussianMass open Finset open scoped Classical /-- Squarefree classes below the original norm cutoff avoiding the excluded primes. -/ def excludedBall (D : ℝ) (E : Finset (Associates GaussianInt)) : Finset (Associates GaussianInt) := (squarefreeBall D).filter (fun a => Disjoint (primeSupport a) E) /-- The actual reciprocal-phi mass, with no alteration of the Gaussian norm. -/ def excludedMass (D : ℝ) (E : Finset (Associates GaussianInt)) : ℝ := ∑ a ∈ excludedBall D E, 1 / squarefreePhi a /-- Delete the excluded prime classes from a squarefree support. -/ def exclusionRemainder (E : Finset (Associates GaussianInt)) (a : Associates GaussianInt) : Associates GaussianInt := ∏ p ∈ primeSupport a \ E, p lemma primeSupport_exclusionRemainder (E : Finset (Associates GaussianInt)) (a : Associates GaussianInt) : primeSupport (exclusionRemainder E a) = primeSupport a \ E := by apply primeSupport_prime_prod intro p hp exact prime_of_mem_primeSupport (mem_sdiff.mp hp).1 lemma squarefree_exclusionRemainder (E : Finset (Associates GaussianInt)) (a : Associates GaussianInt) : Squarefree (exclusionRemainder E a) := by apply squarefree_prime_prod intro p hp exact prime_of_mem_primeSupport (mem_sdiff.mp hp).1 lemma exclusionRemainder_mem {D : ℝ} (hD : 0 ≤ D) (E : Finset (Associates GaussianInt)) {a : Associates GaussianInt} (ha : a ∈ squarefreeBall D) : exclusionRemainder E a ∈ excludedBall D E := by obtain ⟨haSq, haD⟩ := (mem_squarefreeBall hD a).mp ha apply mem_filter.mpr constructor · apply (mem_squarefreeBall hD _).mpr refine ⟨squarefree_exclusionRemainder E a, ?_⟩ have hn : (classNorm (exclusionRemainder E a) : ℝ) ≤ classNorm a := by exact_mod_cast primeSupport_subset_norm_le haSq (show primeSupport a \ E ⊆ primeSupport a from sdiff_subset) exact hn.trans haD · rw [primeSupport_exclusionRemainder] exact disjoint_sdiff_self_left /-- The retained class and the removed support reconstruct the original class. -/ lemma exclusion_reconstruct (E : Finset (Associates GaussianInt)) {a : Associates GaussianInt} (ha : Squarefree a) : exclusionRemainder E a * (∏ p ∈ primeSupport a ∩ E, p) = a := by unfold exclusionRemainder rw [← prod_union (disjoint_sdiff_inter _ _), sdiff_union_inter, primeSupport_prod ha] lemma exclusion_split_injective (E : Finset (Associates GaussianInt)) {a b : Associates GaussianInt} (ha : Squarefree a) (hb : Squarefree b) (h : (exclusionRemainder E a, primeSupport a ∩ E) = (exclusionRemainder E b, primeSupport b ∩ E)) : a = b := by have hfirst : exclusionRemainder E a = exclusionRemainder E b := congrArg Prod.fst h have hsecond : primeSupport a ∩ E = primeSupport b ∩ E := congrArg Prod.snd h calc a = exclusionRemainder E a * (∏ p ∈ primeSupport a ∩ E, p) := (exclusion_reconstruct E ha).symm _ = exclusionRemainder E b * (∏ p ∈ primeSupport b ∩ E, p) := by rw [hfirst, hsecond] _ = b := exclusion_reconstruct E hb lemma squarefreePhi_exclusion_factor (E : Finset (Associates GaussianInt)) (a : Associates GaussianInt) : squarefreePhi a = squarefreePhi (exclusionRemainder E a) * ∏ p ∈ primeSupport a ∩ E, ((classNorm p : ℝ) - 1) := by unfold squarefreePhi rw [primeSupport_exclusionRemainder, ← prod_union (disjoint_sdiff_inter _ _), sdiff_union_inter] lemma reciprocalPhi_exclusion_factor (E : Finset (Associates GaussianInt)) (a : Associates GaussianInt) : 1 / squarefreePhi a = (1 / squarefreePhi (exclusionRemainder E a)) * ∏ p ∈ primeSupport a ∩ E, (1 / ((classNorm p : ℝ) - 1)) := by rw [squarefreePhi_exclusion_factor E a] simp only [one_div, mul_inv_rev, prod_inv_distrib] ring /-- Expanding the finite Euler factor includes every possible removed support. -/ lemma exclusion_powerset_sum (E : Finset (Associates GaussianInt)) : (∑ T ∈ E.powerset, ∏ p ∈ T, (1 / ((classNorm p : ℝ) - 1))) = ∏ p ∈ E, (1 + 1 / ((classNorm p : ℝ) - 1)) := by simpa only [prod_const_one, mul_one, add_comm] using (prod_add (fun p : Associates GaussianInt => 1 / ((classNorm p : ℝ) - 1)) (fun _ => (1 : ℝ)) E).symm /-- Splitting supports injects the original mass into the retained classes times all subsets of the excluded primes. Only the retained class keeps the cutoff. -/ theorem squarefreeMass_le_excludedMass_mul {D : ℝ} (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) (hE : ∀ p ∈ E, Prime p) : squarefreeMass D ≤ excludedMass D E * ∏ p ∈ E, (1 + 1 / ((classNorm p : ℝ) - 1)) := by let split : Associates GaussianInt → Associates GaussianInt × Finset (Associates GaussianInt) := fun a => (exclusionRemainder E a, primeSupport a ∩ E) let weight : Associates GaussianInt × Finset (Associates GaussianInt) → ℝ := fun x => (1 / squarefreePhi x.1) * ∏ p ∈ x.2, (1 / ((classNorm p : ℝ) - 1)) have hsub : (squarefreeBall D).image split ⊆ (excludedBall D E).product E.powerset := by intro x hx obtain ⟨a, ha, rfl⟩ := mem_image.mp hx apply mem_product.mpr exact ⟨exclusionRemainder_mem (by linarith) E ha, mem_powerset.mpr inter_subset_right⟩ have hinj : ∀ a ∈ squarefreeBall D, ∀ b ∈ squarefreeBall D, split a = split b → a = b := by intro a ha b hb hab exact exclusion_split_injective E (mem_filter.mp ha).2 (mem_filter.mp hb).2 hab have hnonneg : ∀ x ∈ (excludedBall D E).product E.powerset, 0 ≤ weight x := by intro x hx obtain ⟨_, hxE⟩ := mem_product.mp hx apply mul_nonneg (le_of_lt (one_div_pos.mpr (squarefreePhi_pos x.1))) apply prod_nonneg intro p hp have hn : (2 : ℝ) ≤ classNorm p := by exact_mod_cast classNorm_prime_two_le (hE p ((mem_powerset.mp hxE) hp)) exact le_of_lt (one_div_pos.mpr (by linarith)) calc squarefreeMass D = ∑ x ∈ (squarefreeBall D).image split, weight x := by rw [sum_image hinj] apply sum_congr rfl intro a _ exact reciprocalPhi_exclusion_factor E a _ ≤ ∑ x ∈ (excludedBall D E).product E.powerset, weight x := sum_le_sum_of_subset_of_nonneg hsub (fun x hx _ => hnonneg x hx) _ = excludedMass D E * (∑ T ∈ E.powerset, ∏ p ∈ T, (1 / ((classNorm p : ℝ) - 1))) := by exact (Finset.sum_product (excludedBall D E) E.powerset weight).trans (Finset.sum_mul_sum (excludedBall D E) E.powerset (fun a : Associates GaussianInt => 1 / squarefreePhi a) (fun T : Finset (Associates GaussianInt) => ∏ p ∈ T, (1 / ((classNorm p : ℝ) - 1)))).symm _ = _ := by rw [exclusion_powerset_sum] lemma excludedMass_nonneg (D : ℝ) (E : Finset (Associates GaussianInt)) : 0 ≤ excludedMass D E := by exact sum_nonneg (fun a _ => le_of_lt (one_div_pos.mpr (squarefreePhi_pos a))) /-- Four Gaussian prime classes of norm at least nine cost at most `(9/8)^4`. -/ theorem exclusion_factor_le_four (E : Finset (Associates GaussianInt)) (hcard : E.card ≤ 4) (hnorm : ∀ p ∈ E, 9 ≤ classNorm p) : (∏ p ∈ E, (1 + 1 / ((classNorm p : ℝ) - 1))) ≤ (9 / 8 : ℝ) ^ 4 := by calc _ ≤ ∏ _p ∈ E, (9 / 8 : ℝ) := by apply prod_le_prod · intro p hp have hn : (9 : ℝ) ≤ classNorm p := by exact_mod_cast hnorm p hp have hi : 0 ≤ 1 / ((classNorm p : ℝ) - 1) := le_of_lt (one_div_pos.mpr (by linarith)) linarith · intro p hp have hn : (9 : ℝ) ≤ classNorm p := by exact_mod_cast hnorm p hp have hi : 1 / ((classNorm p : ℝ) - 1) ≤ (1 / 8 : ℝ) := one_div_le_one_div_of_le (by norm_num) (by linarith) linarith _ = (9 / 8 : ℝ) ^ E.card := prod_const _ _ ≤ _ := pow_le_pow_right₀ (by norm_num) hcard theorem squarefreeMass_le_excludedMass_four {D : ℝ} (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) (hE : ∀ p ∈ E, Prime p) (hcard : E.card ≤ 4) (hnorm : ∀ p ∈ E, 9 ≤ classNorm p) : squarefreeMass D ≤ excludedMass D E * (9 / 8 : ℝ) ^ 4 := (squarefreeMass_le_excludedMass_mul hD E hE).trans (mul_le_mul_of_nonneg_left (exclusion_factor_le_four E hcard hnorm) (excludedMass_nonneg D E)) /-- A rational inert prime has genuine Gaussian norm `p²`, not `p`. -/ lemma classNorm_mk_natCast (p : ℕ) : classNorm (Associates.mk (p : GaussianInt)) = p ^ 2 := by simp [classNorm_mk, Zsqrtd.norm_natCast, Int.natAbs_mul, pow_two] /-- Uniform exclusion for any finite set of at most four distinct inert primes. -/ theorem inert_exclusion_factor_le_four (P : Finset ℕ) (hcard : P.card ≤ 4) (hP : ∀ p ∈ P, p.Prime ∧ p % 4 = 3) : (∏ q ∈ P.image (fun p : ℕ => Associates.mk (p : GaussianInt)), (1 + 1 / ((classNorm q : ℝ) - 1))) ≤ (9 / 8 : ℝ) ^ 4 := by apply exclusion_factor_le_four · exact (Finset.card_image_le (s := P) (f := fun p : ℕ => Associates.mk (p : GaussianInt))).trans hcard · intro q hq obtain ⟨p, hp, rfl⟩ := (Finset.mem_image (s := P) (f := fun p : ℕ => Associates.mk (p : GaussianInt))).mp hq rw [classNorm_mk_natCast] have hp3 := (hP p hp).2 have hpmin : 3 ≤ p := by omega nlinarith theorem squarefreeMass_le_inert_excludedMass_four {D : ℝ} (hD : 1 ≤ D) (P : Finset ℕ) (hcard : P.card ≤ 4) (hP : ∀ p ∈ P, p.Prime ∧ p % 4 = 3) : squarefreeMass D ≤ excludedMass D (P.image (fun p : ℕ => Associates.mk (p : GaussianInt))) * (9 / 8 : ℝ) ^ 4 := by have hprime : ∀ q ∈ P.image (fun p : ℕ => Associates.mk (p : GaussianInt)), Prime q := by intro q hq obtain ⟨p, hp, rfl⟩ := (Finset.mem_image (s := P) (f := fun p : ℕ => Associates.mk (p : GaussianInt))).mp hq exact Associates.prime_mk.mpr (@GaussianInt.prime_of_nat_prime_of_mod_four_eq_three p ⟨(hP p hp).1⟩ (hP p hp).2) exact (squarefreeMass_le_excludedMass_mul hD _ hprime).trans (mul_le_mul_of_nonneg_left (inert_exclusion_factor_le_four P hcard hP) (excludedMass_nonneg D _)) end DistanceCounts.GaussianMass end end BodyFile039 -- Source: DistanceCounts/GaussianSieveFamily.lean section BodyFile040 /-! Selberg weights indexed by genuine Gaussian prime classes, with actual lcm divisors. -/ noncomputable section namespace DistanceCounts.GaussianSieveFamily open Finset GaussianMass open scoped Classical /-- Distinct conjugate Gaussian primes remain distinct indices. -/ abbrev PrimeClass := {p : Associates GaussianInt // Prime p} def primeNorm (p : PrimeClass) : ℝ := classNorm p.val lemma primeNorm_two_le (p : PrimeClass) : 2 ≤ primeNorm p := by change (2 : ℝ) ≤ (classNorm p.val : ℝ) exact_mod_cast classNorm_prime_two_le p.property /-- Lift the actual finite prime support, without adding any artificial primes. -/ def support (a : Associates GaussianInt) : Finset PrimeClass := (primeSupport a).subtype Prime lemma mem_support (a : Associates GaussianInt) (p : PrimeClass) : p ∈ support a ↔ p.val ∈ primeSupport a := Finset.mem_subtype def underlying (S : Finset PrimeClass) : Finset (Associates GaussianInt) := S.map (Function.Embedding.subtype Prime) lemma underlying_support (a : Associates GaussianInt) : underlying (support a) = primeSupport a := Finset.subtype_map_of_mem (fun _ hp => prime_of_mem_primeSupport hp) lemma prime_underlying (S : Finset PrimeClass) : ∀ p ∈ underlying S, Prime p := by intro p hp obtain ⟨q, _, rfl⟩ := mem_map.mp hp exact q.property /-- The squarefree class attached to a finite set of genuine primes. -/ def classProduct (S : Finset PrimeClass) : Associates GaussianInt := ∏ p ∈ S, p.val lemma classProduct_eq (S : Finset PrimeClass) : classProduct S = ∏ p ∈ underlying S, p := by simp [classProduct, underlying] lemma squarefree_classProduct (S : Finset PrimeClass) : Squarefree (classProduct S) := by rw [classProduct_eq] exact squarefree_prime_prod _ (prime_underlying S) lemma primeSupport_classProduct (S : Finset PrimeClass) : primeSupport (classProduct S) = underlying S := by rw [classProduct_eq] exact primeSupport_prime_prod _ (prime_underlying S) lemma support_classProduct (S : Finset PrimeClass) : support (classProduct S) = S := by ext p rw [mem_support, primeSupport_classProduct] simp [underlying, p.property] lemma classProduct_support {a : Associates GaussianInt} (ha : Squarefree a) : classProduct (support a) = a := by rw [classProduct_eq, underlying_support, primeSupport_prod ha] lemma support_injective_squarefree {a b : Associates GaussianInt} (ha : Squarefree a) (hb : Squarefree b) (h : support a = support b) : a = b := by rw [← classProduct_support ha, ← classProduct_support hb, h] lemma classProduct_injective : Function.Injective classProduct := by intro S T h simpa only [support_classProduct] using congrArg support h lemma classProduct_norm (S : Finset PrimeClass) : (classNorm (classProduct S) : ℝ) = SieveWeights.norm primeNorm S := by rw [classProduct_eq, classNorm_prod, Nat.cast_prod] simp [underlying, SieveWeights.norm, primeNorm] lemma support_phi (a : Associates GaussianInt) : SieveWeights.phi primeNorm (support a) = squarefreePhi a := by unfold SieveWeights.phi primeNorm support squarefreePhi exact prod_subtype_of_mem (fun p => (classNorm p : ℝ) - 1) (fun _ hp => prime_of_mem_primeSupport hp) lemma underlying_mono {S T : Finset PrimeClass} (h : S ⊆ T) : underlying S ⊆ underlying T := by intro p hp obtain ⟨q, hq, rfl⟩ := mem_map.mp hp exact mem_map.mpr ⟨q, h hq, rfl⟩ /-- The lower family is precisely the actual squarefree norm ball avoiding `E`. -/ def family (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) : SieveWeights.DivisorFamily PrimeClass where members := (excludedBall D E).image support nonempty := by refine ⟨support 1, mem_image.mpr ⟨1, ?_, rfl⟩⟩ apply mem_filter.mpr constructor · exact (mem_squarefreeBall (by linarith) 1).mpr ⟨squarefree_one, by simpa [classNorm_one] using hD⟩ · simp [primeSupport] lower := by intro S T hT hST obtain ⟨a, ha, rfl⟩ := mem_image.mp hT obtain ⟨haBall, haE⟩ := mem_filter.mp ha obtain ⟨haSq, haD⟩ := (mem_squarefreeBall (by linarith) a).mp haBall have hsub : underlying S ⊆ primeSupport a := by simpa only [underlying_support] using underlying_mono hST refine mem_image.mpr ⟨classProduct S, mem_filter.mpr ⟨?_, ?_⟩, support_classProduct S⟩ · apply (mem_squarefreeBall (by linarith) _).mpr refine ⟨squarefree_classProduct S, ?_⟩ have hn : (classNorm (classProduct S) : ℝ) ≤ classNorm a := by rw [classProduct_eq] exact_mod_cast primeSupport_subset_norm_le haSq hsub exact hn.trans haD · rw [primeSupport_classProduct] exact haE.mono_left hsub lemma mem_family_iff (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) (S : Finset PrimeClass) : S ∈ (family D hD E).members ↔ classProduct S ∈ excludedBall D E := by constructor · intro h obtain ⟨a, ha, rfl⟩ := mem_image.mp h have haSq : Squarefree a := (mem_filter.mp (mem_filter.mp ha).1).2 simpa only [classProduct_support haSq] using ha · intro h exact mem_image.mpr ⟨classProduct S, h, support_classProduct S⟩ lemma family_mass (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) : (family D hD E).mass primeNorm = excludedMass D E := by unfold SieveWeights.DivisorFamily.mass family rw [sum_image] · simp only [support_phi, excludedMass] · intro a ha b hb hab exact support_injective_squarefree (mem_filter.mp (mem_filter.mp ha).1).2 (mem_filter.mp (mem_filter.mp hb).1).2 hab lemma excludedMass_pos (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) : 0 < excludedMass D E := by rw [← family_mass D hD E] exact (family D hD E).mass_pos primeNorm primeNorm_two_le /-- The actual normalized Selberg coefficients, zero off the norm-cutoff family. -/ def weight (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) (S : Finset PrimeClass) : ℝ := (family D hD E).weight primeNorm S lemma weight_empty (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) : weight D hD E ∅ = 1 := (family D hD E).weight_empty primeNorm primeNorm_two_le lemma weight_off_support (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) (S : Finset PrimeClass) (hS : S ∉ (family D hD E).members) : weight D hD E S = 0 := (family D hD E).weight_off_support primeNorm S hS /-- The denominator uses the union (lcm) of prime sets, not their product. -/ theorem quadratic_weight (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) : (∑ S ∈ (family D hD E).members, ∑ T ∈ (family D hD E).members, weight D hD E S * weight D hD E T / SieveWeights.norm primeNorm (S ∪ T)) = 1 / excludedMass D E := by rw [← family_mass D hD E] exact (family D hD E).quadratic_weight primeNorm primeNorm_two_le lemma supported_norm_le (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) {S : Finset PrimeClass} (hS : S ∈ (family D hD E).members) : SieveWeights.norm primeNorm S ≤ D := by have hm := (mem_family_iff D hD E S).mp hS rw [← classProduct_norm] exact ((mem_squarefreeBall (by linarith) _).mp (mem_filter.mp hm).1).2 lemma abs_weight_le (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) {S : Finset PrimeClass} (hS : S ∈ (family D hD E).members) : |weight D hD E S| ≤ D := ((family D hD E).abs_weight_le_norm primeNorm primeNorm_two_le S).trans (supported_norm_le D hD E hS) lemma family_card_le (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) : (family D hD E).members.card ≤ (classBall D).card := by exact (card_image_le).trans (card_le_card (fun _ ha => (mem_filter.mp (mem_filter.mp ha).1).1)) lemma classBall_card_le_twelve {D : ℝ} (hD : 1 ≤ D) : ((classBall D).card : ℝ) ≤ 12 * D := by have hD0 : 0 ≤ D := by linarith have hc := (abs_le.mp (classBall_card_error hD0)).2 have hs : Real.sqrt D ≤ D := by nlinarith [Real.sq_sqrt hD0, Real.sqrt_nonneg D] have hm : Real.pi / 4 * D ≤ D := by have := mul_le_mul_of_nonneg_right (show Real.pi / 4 ≤ 1 by linarith [Real.pi_lt_four]) hD0 simpa using this have he : (Real.pi + 1) * (Real.sqrt D + 1) ≤ 5 * (2 * D) := mul_le_mul (by linarith [Real.pi_lt_four]) (by linarith) (by positivity) (by norm_num) linarith /-- A uniform total coefficient budget obtained from the genuine class count. -/ theorem sum_abs_weight_le (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) : (∑ S ∈ (family D hD E).members, |weight D hD E S|) ≤ 12 * D ^ 2 := by have hc : ((family D hD E).members.card : ℝ) ≤ 12 * D := (Nat.cast_le.mpr (family_card_le D hD E)).trans (classBall_card_le_twelve hD) calc _ ≤ ∑ _S ∈ (family D hD E).members, D := sum_le_sum (fun _ hS => abs_weight_le D hD E hS) _ = ((family D hD E).members.card : ℝ) * D := by simp _ ≤ (12 * D) * D := mul_le_mul_of_nonneg_right hc (by linarith) _ = _ := by ring /-- A representative of the actual associate product, chosen only at this bridge. -/ def representative (S : Finset PrimeClass) : GaussianInt := Classical.choose (Associates.mk_surjective (classProduct S)) lemma mk_representative (S : Finset PrimeClass) : Associates.mk (representative S) = classProduct S := Classical.choose_spec (Associates.mk_surjective (classProduct S)) lemma representative_ne_zero (S : Finset PrimeClass) : representative S ≠ 0 := by apply Associates.mk_ne_zero.mp rw [mk_representative] exact (squarefree_classProduct S).ne_zero lemma representative_norm_nat (S : Finset PrimeClass) : (representative S).norm.natAbs = ∏ p ∈ S, classNorm p.val := by rw [← classNorm_mk, mk_representative, classProduct_eq, classNorm_prod] simp [underlying] lemma representative_norm (S : Finset PrimeClass) : GaussianDivisibility.normMass (representative S) = SieveWeights.norm primeNorm S := by rw [← classProduct_norm, ← mk_representative, classNorm_mk] rfl lemma classProduct_dvd_iff (S : Finset PrimeClass) (a : Associates GaussianInt) : classProduct S ∣ a ↔ ∀ p ∈ S, p.val ∣ a := by induction S using Finset.induction_on with | empty => simp [classProduct] | @insert p S hp ih => have hs : Squarefree (p.val * classProduct S) := by simpa only [classProduct, prod_insert hp] using squarefree_classProduct (insert p S) have hrel := IsRelPrime.of_squarefree_mul hs rw [show classProduct (insert p S) = p.val * classProduct S by simp [classProduct, hp]] constructor · intro h q hq rcases mem_insert.mp hq with rfl | hq · exact dvd_trans (dvd_mul_right _ _) h · exact (ih.mp (dvd_trans (dvd_mul_left _ _) h)) q hq · intro h exact hrel.mul_dvd (h p (mem_insert_self _ _)) (ih.mpr (fun q hq => h q (mem_insert_of_mem hq))) lemma representative_dvd_iff (S : Finset PrimeClass) (z : GaussianInt) : representative S ∣ z ↔ ∀ p ∈ S, p.val ∣ Associates.mk z := by rw [← Associates.mk_dvd_mk, mk_representative, classProduct_dvd_iff] /-- Simultaneous divisibility is exactly the squarefree union, even with overlap. -/ theorem representative_union_dvd (S T : Finset PrimeClass) (z : GaussianInt) : representative (S ∪ T) ∣ z ↔ representative S ∣ z ∧ representative T ∣ z := by simp only [representative_dvd_iff, mem_union, or_imp, forall_and] theorem divisorDisk_inter (S T : Finset PrimeClass) (R : ℝ) : GaussianDivisibility.divisorDisk (representative S) R ∩ GaussianDivisibility.divisorDisk (representative T) R = GaussianDivisibility.divisorDisk (representative (S ∪ T)) R := by ext z simp only [mem_inter, GaussianDivisibility.mem_divisorDisk, representative_union_dvd] tauto /-- The exact quadratic main term expressed with genuine Gaussian lcm norms. -/ theorem quadratic_representative (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) : (∑ S ∈ (family D hD E).members, ∑ T ∈ (family D hD E).members, weight D hD E S * weight D hD E T / GaussianDivisibility.normMass (representative (S ∪ T))) = 1 / excludedMass D E := by simp only [representative_norm] exact quadratic_weight D hD E end DistanceCounts.GaussianSieveFamily end end BodyFile040 -- Source: DistanceCounts/GaussianProgressions.lean section BodyFile041 /-! Exact Gaussian congruence populations and coprime divisibility lattice counts. -/ noncomputable section namespace DistanceCounts.GaussianProgressions open GaussianDivisibility /-- The actual closed disk restricted to one rational-modulus Gaussian congruence. -/ def progression (a : GaussianInt) (q : ℕ) (R : ℝ) : Finset GaussianInt := by classical exact (gaussianDisk 0 R).filter (fun z => (q : GaussianInt) ∣ z - a) /-- The same progression with genuine Gaussian divisibility imposed. -/ def divisibleProgression (a : GaussianInt) (q : ℕ) (d : GaussianInt) (R : ℝ) : Finset GaussianInt := by classical exact (progression a q R).filter (fun z => d ∣ z) lemma mem_progression (a z : GaussianInt) (q : ℕ) (R : ℝ) : z ∈ progression a q R ↔ dist (z : ℂ) 0 ≤ R ∧ (q : GaussianInt) ∣ z - a := by classical simp [progression, mem_gaussianDisk] lemma mem_divisibleProgression (a z : GaussianInt) (q : ℕ) (d : GaussianInt) (R : ℝ) : z ∈ divisibleProgression a q d R ↔ dist (z : ℂ) 0 ≤ R ∧ (q : GaussianInt) ∣ z - a ∧ d ∣ z := by classical simp [divisibleProgression, mem_progression, and_assoc] /-- Bezout coefficients give an actual simultaneous residue, with no condition on `a`. -/ theorem exists_crt_residue (a m d : GaussianInt) (hmd : IsCoprime m d) : ∃ b : GaussianInt, m ∣ b - a ∧ d ∣ b := by obtain ⟨u, v, huv⟩ := hmd refine ⟨v * d * a, ?_, ?_⟩ · refine ⟨-(u * a), ?_⟩ calc v * d * a - a = ((u * m + v * d) - 1) * a + m * (-(u * a)) := by ring _ = m * (-(u * a)) := by rw [huv]; ring · exact ⟨v * a, by ring⟩ /-- Once a simultaneous residue is fixed, the two congruences are exactly one ideal coset. -/ lemma crt_dvd_iff (a b m d z : GaussianInt) (hmd : IsCoprime m d) (hb : m ∣ b - a) (hdb : d ∣ b) : (m ∣ z - a ∧ d ∣ z) ↔ m * d ∣ z - b := by constructor · rintro ⟨hza, hdz⟩ apply hmd.mul_dvd · have he : z - b = (z - a) - (b - a) := by ring rw [he] exact dvd_sub hza hb · exact dvd_sub hdz hdb · intro hz have hmz : m ∣ z - b := dvd_trans (dvd_mul_right m d) hz have hdz : d ∣ z - b := dvd_trans (dvd_mul_left d m) hz constructor · have he : z - a = (z - b) + (b - a) := by ring rw [he] exact dvd_add hmz hb · have he : z = (z - b) + b := by ring rw [he] exact dvd_add hdz hdb open scoped Classical in /-- The CRT identity is an equality of finite sets, for every centre and every radius. In particular the boundary is closed and zero is never silently discarded. -/ theorem disk_filter_eq_coset (a b m d : GaussianInt) (hm : m ≠ 0) (hd : d ≠ 0) (hmd : IsCoprime m d) (hb : m ∣ b - a) (hdb : d ∣ b) (c : ℂ) (R : ℝ) : ((gaussianDisk c R).filter (fun z => m ∣ z - a ∧ d ∣ z)) = gaussianCosetDisk b (m * d) c R := by classical ext z rw [Finset.mem_filter, mem_gaussianDisk, mem_gaussianCosetDisk _ _ _ (mul_ne_zero hm hd), crt_dvd_iff a b m d z hmd hb hdb] constructor · rintro ⟨hR, w, hw⟩ refine ⟨⟨w, ?_⟩, hR⟩ rw [← hw] ring · rintro ⟨⟨w, hw⟩, hR⟩ refine ⟨hR, w, ?_⟩ rw [← hw] ring /-- Any Bezout residue identifies the actual filtered progression with its ideal lattice. -/ theorem divisibleProgression_eq_coset (a b : GaussianInt) (q : ℕ) (hq : 0 < q) (d : GaussianInt) (hd : d ≠ 0) (hqd : IsCoprime (q : GaussianInt) d) (hb : (q : GaussianInt) ∣ b - a) (hdb : d ∣ b) (R : ℝ) : divisibleProgression a q d R = gaussianCosetDisk b ((q : GaussianInt) * d) 0 R := by classical have hq0 : (q : GaussianInt) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt hq) simpa only [divisibleProgression, progression, Finset.filter_filter] using disk_filter_eq_coset a b (q : GaussianInt) d hq0 hd hqd hb hdb 0 R /-- Both the residue and the finite-set CRT identity are constructed, not assumed. -/ theorem exists_divisibleProgression_eq_coset (a : GaussianInt) (q : ℕ) (hq : 0 < q) (d : GaussianInt) (hd : d ≠ 0) (hqd : IsCoprime (q : GaussianInt) d) (R : ℝ) : ∃ b : GaussianInt, (q : GaussianInt) ∣ b - a ∧ d ∣ b ∧ divisibleProgression a q d R = gaussianCosetDisk b ((q : GaussianInt) * d) 0 R := by obtain ⟨b, hb, hdb⟩ := exists_crt_residue a (q : GaussianInt) d hqd exact ⟨b, hb, hdb, divisibleProgression_eq_coset a b q hq d hd hqd hb hdb R⟩ lemma complex_norm_natCast (q : ℕ) : ‖((q : GaussianInt) : ℂ)‖ = (q : ℝ) := by have h : ‖((q : GaussianInt) : ℂ)‖ ^ 2 = (q : ℝ) ^ 2 := by rw [← normMass_eq_sq_norm, normMass_natCast] nlinarith [norm_nonneg ((q : GaussianInt) : ℂ), Nat.cast_nonneg (α := ℝ) q] /-- The quantitative CRT count at its exact lattice scale. -/ theorem divisibleProgression_card_error_scaled (a : GaussianInt) (q : ℕ) (hq : 0 < q) (d : GaussianInt) (hd : d ≠ 0) (hqd : IsCoprime (q : GaussianInt) d) {R : ℝ} (hR : 0 ≤ R) : |((divisibleProgression a q d R).card : ℝ) - Real.pi * R ^ 2 / ((q : ℝ) ^ 2 * normMass d)| ≤ (4 * Real.pi) * (R / ((q : ℝ) * ‖(d : ℂ)‖) + 1) := by obtain ⟨b, hb, hdb, heq⟩ := exists_divisibleProgression_eq_coset a q hq d hd hqd R have hq0 : (q : GaussianInt) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt hq) have he := gaussianCosetDisk_card_error b ((q : GaussianInt) * d) (mul_ne_zero hq0 hd) 0 hR rw [← heq, GaussianInt.toComplex_mul, norm_mul, complex_norm_natCast] at he simpa only [normMass_eq_sq_norm, div_pow, mul_pow, mul_div_assoc] using he /-- The same exact scale written using the square root of the Gaussian norm mass. -/ theorem divisibleProgression_card_error_sqrt (a : GaussianInt) (q : ℕ) (hq : 0 < q) (d : GaussianInt) (hd : d ≠ 0) (hqd : IsCoprime (q : GaussianInt) d) {R : ℝ} (hR : 0 ≤ R) : |((divisibleProgression a q d R).card : ℝ) - Real.pi * R ^ 2 / ((q : ℝ) ^ 2 * normMass d)| ≤ (4 * Real.pi) * (R / ((q : ℝ) * Real.sqrt (normMass d)) + 1) := by simpa only [normMass_eq_sq_norm, Real.sqrt_sq (norm_nonneg (d : ℂ))] using divisibleProgression_card_error_scaled a q hq d hd hqd hR /-- Uniformity in the nonzero divisor preserves the rational progression scale `R/q`. -/ theorem divisibleProgression_card_error (a : GaussianInt) (q : ℕ) (hq : 0 < q) (d : GaussianInt) (hd : d ≠ 0) (hqd : IsCoprime (q : GaussianInt) d) {R : ℝ} (hR : 0 ≤ R) : |((divisibleProgression a q d R).card : ℝ) - Real.pi * R ^ 2 / ((q : ℝ) ^ 2 * normMass d)| ≤ (4 * Real.pi) * (R / (q : ℝ) + 1) := by apply (divisibleProgression_card_error_scaled a q hq d hd hqd hR).trans have hn := one_le_complex_norm hd have hqR : 0 < (q : ℝ) := by exact_mod_cast hq have hden : (q : ℝ) ≤ (q : ℝ) * ‖(d : ℂ)‖ := by nlinarith have hs : R / ((q : ℝ) * ‖(d : ℂ)‖) ≤ R / (q : ℝ) := div_le_div_of_nonneg_left hR hqR hden exact mul_le_mul_of_nonneg_left (show R / ((q : ℝ) * ‖(d : ℂ)‖) + 1 ≤ R / (q : ℝ) + 1 by linarith) (by positivity) /-- A single congruence is already the actual affine ideal coset. -/ theorem progression_eq_coset (a : GaussianInt) (q : ℕ) (hq : 0 < q) (R : ℝ) : progression a q R = gaussianCosetDisk a (q : GaussianInt) 0 R := by classical have hq0 : (q : GaussianInt) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt hq) ext z rw [mem_progression, mem_gaussianCosetDisk _ _ _ hq0] constructor · rintro ⟨hR, w, hw⟩ refine ⟨⟨w, ?_⟩, hR⟩ rw [← hw] ring · rintro ⟨⟨w, hw⟩, hR⟩ refine ⟨hR, w, ?_⟩ rw [← hw] ring /-- The progression itself has density `1/q²`, uniformly in its residue. -/ theorem progression_card_error (a : GaussianInt) (q : ℕ) (hq : 0 < q) {R : ℝ} (hR : 0 ≤ R) : |((progression a q R).card : ℝ) - Real.pi * R ^ 2 / (q : ℝ) ^ 2| ≤ (4 * Real.pi) * (R / (q : ℝ) + 1) := by have hq0 : (q : GaussianInt) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt hq) have he := gaussianCosetDisk_card_error a (q : GaussianInt) hq0 0 hR rw [← progression_eq_coset a q hq R, complex_norm_natCast] at he simpa only [div_pow, mul_div_assoc] using he end DistanceCounts.GaussianProgressions end end BodyFile041 -- Source: DistanceCounts/GaussianSieve.lean section BodyFile042 /-! The finite Selberg upper bound for actual Gaussian primes in a congruence class. -/ noncomputable section namespace DistanceCounts.GaussianSieve open Finset GaussianMass GaussianSieveFamily GaussianDivisibility GaussianProgressions open scoped Classical /-- Exclude exactly the associate classes of the rational primes in the modulus. -/ def excludedClasses (P : Finset ℕ) : Finset (Associates GaussianInt) := P.image (fun p : ℕ => Associates.mk (p : GaussianInt)) /-- All Gaussian prime elements in the actual progression, including every associate. -/ def primeProgression (a : GaussianInt) (q : ℕ) (R : ℝ) : Finset GaussianInt := (progression a q R).filter Prime lemma supported_disjoint (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) {S : Finset PrimeClass} (hS : S ∈ (family D hD E).members) : Disjoint (underlying S) E := by have h := (mem_filter.mp ((mem_family_iff D hD E S).mp hS)).2 rwa [primeSupport_classProduct] at h lemma representative_not_dvd_of_disjoint (P : Finset ℕ) (hprime : ∀ p ∈ P, p.Prime) (hinert : ∀ p ∈ P, p % 4 = 3) (S : Finset PrimeClass) (hS : Disjoint (underlying S) (excludedClasses P)) {p : ℕ} (hp : p ∈ P) : ¬(p : GaussianInt) ∣ representative S := by intro hd have hpG : Prime (p : GaussianInt) := @GaussianInt.prime_of_nat_prime_of_mod_four_eq_three p ⟨hprime p hp⟩ (hinert p hp) have hd' : Associates.mk (p : GaussianInt) ∣ classProduct S := by rw [← mk_representative] exact Associates.mk_dvd_mk.mpr hd have hm : Associates.mk (p : GaussianInt) ∈ underlying S := by rw [← primeSupport_classProduct] exact (mem_primeSupport (squarefree_classProduct S).ne_zero).mpr ⟨Associates.prime_mk.mpr hpG, hd'⟩ exact Finset.disjoint_left.mp hS hm (mem_image.mpr ⟨p, hp, rfl⟩) /-- Exclusion proves Bezout coprimality for the actual chosen Gaussian divisor. -/ lemma representative_coprime_of_disjoint (P : Finset ℕ) (hprime : ∀ p ∈ P, p.Prime) (hinert : ∀ p ∈ P, p % 4 = 3) (S : Finset PrimeClass) (hS : Disjoint (underlying S) (excludedClasses P)) : IsCoprime ((∏ p ∈ P, p : ℕ) : GaussianInt) (representative S) := by rw [Nat.cast_prod] apply IsCoprime.prod_left intro p hp have hpG : Prime (p : GaussianInt) := @GaussianInt.prime_of_nat_prime_of_mod_four_eq_three p ⟨hprime p hp⟩ (hinert p hp) exact hpG.coprime_iff_not_dvd.mpr (representative_not_dvd_of_disjoint P hprime hinert S hS hp) lemma supported_representative_coprime (P : Finset ℕ) (hprime : ∀ p ∈ P, p.Prime) (hinert : ∀ p ∈ P, p % 4 = 3) (D : ℝ) (hD : 1 ≤ D) {S : Finset PrimeClass} (hS : S ∈ (family D hD (excludedClasses P)).members) : IsCoprime ((∏ p ∈ P, p : ℕ) : GaussianInt) (representative S) := representative_coprime_of_disjoint P hprime hinert S (supported_disjoint D hD _ hS) /-- Lcm divisors remain coprime, although their norms need not remain below `D`. -/ lemma supported_union_representative_coprime (P : Finset ℕ) (hprime : ∀ p ∈ P, p.Prime) (hinert : ∀ p ∈ P, p % 4 = 3) (D : ℝ) (hD : 1 ≤ D) {S T : Finset PrimeClass} (hS : S ∈ (family D hD (excludedClasses P)).members) (hT : T ∈ (family D hD (excludedClasses P)).members) : IsCoprime ((∏ p ∈ P, p : ℕ) : GaussianInt) (representative (S ∪ T)) := by apply representative_coprime_of_disjoint P hprime hinert apply Finset.disjoint_left.mpr intro p hp hpE obtain ⟨s, hs, rfl⟩ := mem_map.mp hp rcases mem_union.mp hs with hs | hs · exact Finset.disjoint_left.mp (supported_disjoint D hD _ hS) (mem_map.mpr ⟨s, hs, rfl⟩) hpE · exact Finset.disjoint_left.mp (supported_disjoint D hD _ hT) (mem_map.mpr ⟨s, hs, rfl⟩) hpE /-- The Selberg score uses genuine element divisibility, not a surrogate indicator. -/ def sieveScore (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) (z : GaussianInt) : ℝ := ∑ S ∈ (family D hD E).members, if representative S ∣ z then weight D hD E S else 0 lemma supported_dvd_large_prime_iff (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) {S : Finset PrimeClass} (hS : S ∈ (family D hD E).members) {z : GaussianInt} (hz : Prime z) (hDz : D < normMass z) : representative S ∣ z ↔ S = ∅ := by constructor · intro hd rcases hz.irreducible.dvd_iff.mp hd with hu | ha · apply classProduct_injective rw [← mk_representative, Associates.mk_eq_one.mpr hu] simp [classProduct] · have hn : normMass z = normMass (representative S) := by unfold normMass exact_mod_cast congrArg Int.natAbs (Zsqrtd.norm_eq_of_associated (by norm_num) ha) have hbound := supported_norm_le D hD E hS rw [← representative_norm, ← hn] at hbound exact False.elim (not_lt_of_ge hbound hDz) · rintro rfl simp [representative_dvd_iff] /-- Every prime beyond the cutoff has score exactly one. -/ theorem sieveScore_large_prime (D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) {z : GaussianInt} (hz : Prime z) (hDz : D < normMass z) : sieveScore D hD E z = 1 := by unfold sieveScore have he : (∑ S ∈ (family D hD E).members, if representative S ∣ z then weight D hD E S else 0) = ∑ S ∈ (family D hD E).members, if S = ∅ then weight D hD E S else 0 := by apply sum_congr rfl intro S hS rw [supported_dvd_large_prime_iff D hD E hS hz hDz] by_cases heq : S = ∅ <;> simp only [heq, ite_true, ite_false] rw [he] simp [(family D hD E).empty_mem, weight_empty] /-- Even the entire small norm ball, not just its primes, costs at most `9πD`. -/ lemma smallProgression_card_le (a : GaussianInt) (q : ℕ) (R D : ℝ) (hD : 1 ≤ D) : (((progression a q R).filter (fun z => normMass z ≤ D)).card : ℝ) ≤ 9 * Real.pi * D := by have hD0 : 0 ≤ D := by linarith have hsub : (progression a q R).filter (fun z => normMass z ≤ D) ⊆ gaussianDisk 0 (Real.sqrt D) := by intro z hz apply (mem_gaussianDisk _ _ _).mpr have hn := (mem_filter.mp hz).2 simpa only [dist_zero_right, gaussian_complex_norm, normMass] using Real.sqrt_le_sqrt hn have hc : (((progression a q R).filter (fun z => normMass z ≤ D)).card : ℝ) ≤ ((gaussianDisk 0 (Real.sqrt D)).card : ℝ) := by exact_mod_cast card_le_card hsub have hs : 1 ≤ Real.sqrt D := by nlinarith [Real.sq_sqrt hD0, Real.sqrt_nonneg D] have he := gaussianDisk_card_upper (0 : ℂ) (Real.sqrt_nonneg D) have hs2 : (Real.sqrt D + 2) ^ 2 ≤ 9 * D := by nlinarith [Real.sq_sqrt hD0] apply hc.trans (he.trans _) calc Real.pi * (Real.sqrt D + 2) ^ 2 ≤ Real.pi * (9 * D) := mul_le_mul_of_nonneg_left hs2 Real.pi_nonneg _ = 9 * Real.pi * D := by ring /-- Pointwise prime majorization, separating only the actual small norm population. -/ lemma primeProgression_card_le_score (a : GaussianInt) (q : ℕ) (R D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) : ((primeProgression a q R).card : ℝ) ≤ 9 * Real.pi * D + ∑ z ∈ progression a q R, sieveScore D hD E z ^ 2 := by have hpoint : ∀ z ∈ progression a q R, (if Prime z then (1 : ℝ) else 0) ≤ (if normMass z ≤ D then (1 : ℝ) else 0) + sieveScore D hD E z ^ 2 := by intro z _ by_cases hz : Prime z · by_cases hs : normMass z ≤ D · simp only [hz, hs, ite_true] nlinarith [sq_nonneg (sieveScore D hD E z)] · rw [sieveScore_large_prime D hD E hz (lt_of_not_ge hs)] simp [hz, hs] · simp only [hz, ite_false] split_ifs <;> nlinarith [sq_nonneg (sieveScore D hD E z)] have he := sum_le_sum hpoint have hsmall := smallProgression_card_le a q R D hD have hc : ((primeProgression a q R).card : ℝ) = ∑ z ∈ progression a q R, if Prime z then (1 : ℝ) else 0 := by simp [primeProgression, ← sum_filter] have hs : (((progression a q R).filter (fun z => normMass z ≤ D)).card : ℝ) = ∑ z ∈ progression a q R, if normMass z ≤ D then (1 : ℝ) else 0 := by simp [← sum_filter] rw [sum_add_distrib, ← hc, ← hs] at he linarith /-- Exact expansion over the real progression into its genuine lcm count matrix. -/ theorem sieveScore_second_moment (a : GaussianInt) (q : ℕ) (R D : ℝ) (hD : 1 ≤ D) (E : Finset (Associates GaussianInt)) : (∑ z ∈ progression a q R, sieveScore D hD E z ^ 2) = ∑ S ∈ (family D hD E).members, ∑ T ∈ (family D hD E).members, weight D hD E S * weight D hD E T * ((divisibleProgression a q (representative (S ∪ T)) R).card : ℝ) := by unfold sieveScore simp_rw [pow_two, sum_mul, mul_sum] rw [sum_comm] apply sum_congr rfl intro S _ rw [sum_comm] apply sum_congr rfl intro T _ have hterm : ∀ z : GaussianInt, (if representative S ∣ z then weight D hD E S else 0) * (if representative T ∣ z then weight D hD E T else 0) = if representative (S ∪ T) ∣ z then weight D hD E S * weight D hD E T else 0 := by intro z rw [representative_union_dvd] split_ifs <;> simp_all simp_rw [hterm] rw [← sum_filter] simp [divisibleProgression, mul_comm] /-- Signed coefficients are handled by absolute errors before summation. -/ lemma weighted_card_upper (w c m e : ℝ) (he : |c - m| ≤ e) : w * c ≤ w * m + |w| * e := by have hh : w * (c - m) ≤ |w| * e := calc w * (c - m) ≤ |w * (c - m)| := le_abs_self _ _ = |w| * |c - m| := abs_mul _ _ _ ≤ |w| * e := mul_le_mul_of_nonneg_left he (abs_nonneg _) nlinarith /-- The finite sieve bound has no residue, coprimality, or mass-growth hypothesis. The constant counts all prime elements rather than quotienting out their four units. -/ theorem primeProgression_card_upper (P : Finset ℕ) (hprime : ∀ p ∈ P, p.Prime) (hinert : ∀ p ∈ P, p % 4 = 3) (a : GaussianInt) (D : ℝ) (hD : 1 ≤ D) {R : ℝ} (hR : 0 ≤ R) : ((primeProgression a (∏ p ∈ P, p) R).card : ℝ) ≤ 9 * Real.pi * D + Real.pi * R ^ 2 / (((∏ p ∈ P, p : ℕ) : ℝ) ^ 2 * excludedMass D (excludedClasses P)) + 576 * Real.pi * (R / ((∏ p ∈ P, p : ℕ) : ℝ) + 1) * D ^ 4 := by let q : ℕ := ∏ p ∈ P, p let E := excludedClasses P let F := (family D hD E).members let w := weight D hD E let A : ℝ := Real.pi * R ^ 2 / (q : ℝ) ^ 2 let e : ℝ := 4 * Real.pi * (R / (q : ℝ) + 1) have hq : 0 < q := prod_pos (fun p hp => (hprime p hp).pos) have he0 : 0 ≤ e := by dsimp [e]; positivity have hterm : ∀ S ∈ F, ∀ T ∈ F, w S * w T * ((divisibleProgression a q (representative (S ∪ T)) R).card : ℝ) ≤ A * (w S * w T / normMass (representative (S ∪ T))) + e * (|w S| * |w T|) := by intro S hS T hT have hc := divisibleProgression_card_error a q hq (representative (S ∪ T)) (representative_ne_zero _) (supported_union_representative_coprime P hprime hinert D hD hS hT) hR have hh := weighted_card_upper (w S * w T) _ _ e hc convert hh using 1 <;> simp only [abs_mul, A, div_eq_mul_inv, mul_inv_rev] <;> ring have hmatrix := sum_le_sum (fun S hS => sum_le_sum (fun T hT => hterm S hS T hT)) have hmain : (∑ S ∈ F, ∑ T ∈ F, A * (w S * w T / normMass (representative (S ∪ T)))) = A / excludedMass D E := by simp_rw [← mul_sum] rw [quadratic_representative D hD E] ring have herr : (∑ S ∈ F, ∑ T ∈ F, e * (|w S| * |w T|)) = e * (∑ S ∈ F, |w S|) ^ 2 := by simp_rw [← mul_sum] rw [← sum_mul] ring simp_rw [sum_add_distrib] at hmatrix rw [hmain, herr] at hmatrix have hbudget := sum_abs_weight_le D hD E have hsum0 : 0 ≤ ∑ S ∈ F, |w S| := sum_nonneg (fun _ _ => abs_nonneg _) have hbudget2 : (∑ S ∈ F, |w S|) ^ 2 ≤ 144 * D ^ 4 := by have hsq := (sq_le_sq₀ hsum0 (show 0 ≤ 12 * D ^ 2 by positivity)).mpr hbudget nlinarith have herrbound := mul_le_mul_of_nonneg_left hbudget2 he0 have hscore := primeProgression_card_le_score a q R D hD E rw [sieveScore_second_moment] at hscore have hm : A / excludedMass D E = Real.pi * R ^ 2 / ((q : ℝ) ^ 2 * excludedMass D E) := by dsimp [A] rw [div_div] have he : e * (144 * D ^ 4) = 576 * Real.pi * (R / (q : ℝ) + 1) * D ^ 4 := by dsimp [e]; ring rw [hm] at hmatrix rw [he] at herrbound change ((primeProgression a q R).card : ℝ) ≤ 9 * Real.pi * D + Real.pi * R ^ 2 / ((q : ℝ) ^ 2 * excludedMass D E) + 576 * Real.pi * (R / (q : ℝ) + 1) * D ^ 4 linarith end DistanceCounts.GaussianSieve end end BodyFile042 -- Source: DistanceCounts/GaussianPrimeBounds.lean section BodyFile043 /-! Uniform polylogarithmic-modulus bounds from the finite Gaussian Selberg sieve. -/ noncomputable section namespace DistanceCounts.GaussianPrimeBounds open Filter Finset GaussianMass GaussianSieve open scoped Topology Classical /-- The normalized boundary and small-prime errors, independently of the modulus. -/ def normalizedError (A Z : ℝ) : ℝ := 9 * Real.pi * ((Real.log Z) ^ (2 * A + 1) / Z ^ (15 / 16 : ℝ)) + 576 * Real.pi * ((Real.log Z) ^ (A + 1) / Z ^ (1 / 4 : ℝ) + (Real.log Z) ^ (2 * A + 1) / Z ^ (3 / 4 : ℝ)) theorem normalizedError_tendsto (A : ℝ) : Tendsto (normalizedError A) atTop (𝓝 0) := by unfold normalizedError have h₁ := (isLittleO_log_rpow_rpow_atTop (2 * A + 1) (by norm_num : (0 : ℝ) < 15 / 16)).tendsto_div_nhds_zero have h₂ := (isLittleO_log_rpow_rpow_atTop (A + 1) (by norm_num : (0 : ℝ) < 1 / 4)).tendsto_div_nhds_zero have h₃ := (isLittleO_log_rpow_rpow_atTop (2 * A + 1) (by norm_num : (0 : ℝ) < 3 / 4)).tendsto_div_nhds_zero simpa only [normalizedError, mul_zero, zero_add] using (h₁.const_mul (9 * Real.pi)).add ((h₂.add h₃).const_mul (576 * Real.pi)) /-- Four excluded inert classes lose only a fixed factor in the logarithmic mass. -/ theorem eventually_excludedMass_log_lower : ∃ k : ℝ, 0 < k ∧ ∀ᶠ Z : ℝ in atTop, 1 ≤ Z ^ (1 / 16 : ℝ) ∧ ∀ P : Finset ℕ, P.card ≤ 4 → (∀ p ∈ P, p.Prime ∧ p % 4 = 3) → k * Real.log Z ≤ excludedMass (Z ^ (1 / 16 : ℝ)) (excludedClasses P) := by obtain ⟨c, D₀, hc, _, hgrowth⟩ := squarefreeMass_log_growth let k : ℝ := c / (16 * (9 / 8 : ℝ) ^ 4) refine ⟨k, by dsimp [k]; positivity, ?_⟩ filter_upwards [eventually_gt_atTop (1 : ℝ), (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 16)).eventually (eventually_ge_atTop (max D₀ 1))] with Z hZ hD have hD₁ : 1 ≤ Z ^ (1 / 16 : ℝ) := (le_max_right _ _).trans hD refine ⟨hD₁, fun P hcard hP => ?_⟩ have hm := (hgrowth _ ((le_max_left _ _).trans hD)).trans (squarefreeMass_le_inert_excludedMass_four hD₁ P hcard hP) rw [Real.log_rpow (by linarith : 0 < Z)] at hm change k * Real.log Z ≤ excludedMass (Z ^ (1 / 16 : ℝ)) (P.image (fun p : ℕ => Associates.mk (p : GaussianInt))) dsimp [k] norm_num at hm ⊢ nlinarith /-- Exact normalization before the modulus is bounded; in particular no `q` is dropped. -/ lemma sieve_error_normalization {Z q : ℝ} (hZ : 0 < Z) (hq : 0 < q) : (9 * Real.pi * Z ^ (1 / 16 : ℝ) + 576 * Real.pi * (Real.sqrt Z / q + 1) * (Z ^ (1 / 16 : ℝ)) ^ 4) * (q ^ 2 * Real.log Z / Z) = 9 * Real.pi * (q ^ 2 * Real.log Z / Z ^ (15 / 16 : ℝ)) + 576 * Real.pi * (q * Real.log Z / Z ^ (1 / 4 : ℝ) + q ^ 2 * Real.log Z / Z ^ (3 / 4 : ℝ)) := by let t := Z ^ (1 / 16 : ℝ) have ht : 0 < t := Real.rpow_pos_of_pos hZ _ have h16 : t ^ (16 : ℕ) = Z := by dsimp [t] rw [← Real.rpow_mul_natCast hZ.le] norm_num have h8 : t ^ (8 : ℕ) = Real.sqrt Z := by dsimp [t] rw [← Real.rpow_mul_natCast hZ.le, Real.sqrt_eq_rpow] norm_num have h15 : t ^ (15 : ℕ) = Z ^ (15 / 16 : ℝ) := by dsimp [t] rw [← Real.rpow_mul_natCast hZ.le] norm_num have h4 : t ^ (4 : ℕ) = Z ^ (1 / 4 : ℝ) := by dsimp [t] rw [← Real.rpow_mul_natCast hZ.le] norm_num have h12 : t ^ (12 : ℕ) = Z ^ (3 / 4 : ℝ) := by dsimp [t] rw [← Real.rpow_mul_natCast hZ.le] norm_num change (9 * Real.pi * t + 576 * Real.pi * (Real.sqrt Z / q + 1) * t ^ 4) * (q ^ 2 * Real.log Z / Z) = _ rw [← h8, ← h15, ← h4, ← h12] conv_lhs => arg 2; arg 2; rw [← h16] field_simp [ne_of_gt ht, ne_of_gt hq] <;> ring lemma sieve_error_le_normalizedError {A Z q : ℝ} (hZ : 1 < Z) (hq : 0 < q) (hqlog : q ≤ (Real.log Z) ^ A) : (9 * Real.pi * Z ^ (1 / 16 : ℝ) + 576 * Real.pi * (Real.sqrt Z / q + 1) * (Z ^ (1 / 16 : ℝ)) ^ 4) * (q ^ 2 * Real.log Z / Z) ≤ normalizedError A Z := by have hZ₀ : 0 < Z := lt_trans zero_lt_one hZ have hL : 0 < Real.log Z := Real.log_pos hZ have hqL : q * Real.log Z ≤ (Real.log Z) ^ (A + 1) := by rw [Real.rpow_add_one (ne_of_gt hL)] exact mul_le_mul_of_nonneg_right hqlog hL.le have hq₂L : q ^ 2 * Real.log Z ≤ (Real.log Z) ^ (2 * A + 1) := by rw [Real.rpow_add_one (ne_of_gt hL)] have he : (Real.log Z) ^ (2 * A) = ((Real.log Z) ^ A) ^ (2 : ℕ) := by rw [← Real.rpow_mul_natCast hL.le] congr 1 ring rw [he] exact mul_le_mul_of_nonneg_right ((sq_le_sq₀ hq.le (Real.rpow_pos_of_pos hL A).le).mpr hqlog) hL.le rw [sieve_error_normalization hZ₀ hq] unfold normalizedError exact add_le_add (mul_le_mul_of_nonneg_left (div_le_div_of_nonneg_right hq₂L (Real.rpow_pos_of_pos hZ₀ _).le) (by positivity)) (mul_le_mul_of_nonneg_left (add_le_add (div_le_div_of_nonneg_right hqL (Real.rpow_pos_of_pos hZ₀ _).le) (div_le_div_of_nonneg_right hq₂L (Real.rpow_pos_of_pos hZ₀ _).le)) (by positivity)) /-- Uniform in the residue and in every product of at most four inert rational primes. The cutoff and constant depend only on `A`, not on the modulus or its prime factors. -/ theorem primeProgression_card_polylog (A : ℝ) (_hA : 0 < A) : ∃ C Z₀ : ℝ, 0 < C ∧ 1 < Z₀ ∧ ∀ Z : ℝ, Z₀ ≤ Z → ∀ P : Finset ℕ, P.card ≤ 4 → (∀ p ∈ P, p.Prime ∧ p % 4 = 3) → (((∏ p ∈ P, p : ℕ) : ℝ) ≤ (Real.log Z) ^ A) → ∀ a : GaussianInt, ((primeProgression a (∏ p ∈ P, p) (Real.sqrt Z)).card : ℝ) ≤ C * Z / (((∏ p ∈ P, p : ℕ) : ℝ) ^ 2 * Real.log Z) := by obtain ⟨k, hk, hmass⟩ := eventually_excludedMass_log_lower have herr : ∀ᶠ Z : ℝ in atTop, normalizedError A Z < 1 := (normalizedError_tendsto A).eventually (gt_mem_nhds (by norm_num : (0 : ℝ) < 1)) obtain ⟨Z₁, hZ₁⟩ := eventually_atTop.mp (hmass.and herr) refine ⟨Real.pi / k + 1, max Z₁ 2, by positivity, lt_of_lt_of_le (by norm_num : (1 : ℝ) < 2) (le_max_right _ _), ?_⟩ intro Z hZ P hcard hP hqlog a have hZ₁' := hZ₁ Z ((le_max_left _ _).trans hZ) have hZ₂ : 1 < Z := lt_of_lt_of_le (by norm_num : (1 : ℝ) < 2) ((le_max_right _ _).trans hZ) have hZ₀ : 0 < Z := lt_trans zero_lt_one hZ₂ have hL : 0 < Real.log Z := Real.log_pos hZ₂ let q : ℝ := ((∏ p ∈ P, p : ℕ) : ℝ) have hq : 0 < q := by change (0 : ℝ) < ((∏ p ∈ P, p : ℕ) : ℝ) exact_mod_cast (Finset.prod_pos (fun p hp => (hP p hp).1.pos) : 0 < ∏ p ∈ P, p) let M := excludedMass (Z ^ (1 / 16 : ℝ)) (excludedClasses P) have hM : k * Real.log Z ≤ M := hZ₁'.1.2 P hcard hP have hM₀ : 0 < M := lt_of_lt_of_le (mul_pos hk hL) hM let N := q ^ 2 * Real.log Z / Z have hN : 0 < N := by dsimp [N]; positivity have hfinite := primeProgression_card_upper P (fun p hp => (hP p hp).1) (fun p hp => (hP p hp).2) a (Z ^ (1 / 16 : ℝ)) hZ₁'.1.1 (Real.sqrt_nonneg Z) rw [Real.sq_sqrt hZ₀.le] at hfinite have hfiniteN := mul_le_mul_of_nonneg_right hfinite hN.le have hmain : (Real.pi * Z / (q ^ 2 * M)) * N ≤ Real.pi / k := by have he : (Real.pi * Z / (q ^ 2 * M)) * N = Real.pi * Real.log Z / M := by dsimp [N] field_simp [ne_of_gt hq, ne_of_gt hZ₀, ne_of_gt hM₀] <;> ring rw [he] apply (div_le_iff₀ hM₀).mpr have hh := mul_le_mul_of_nonneg_left hM (le_of_lt (div_pos Real.pi_pos hk)) calc Real.pi * Real.log Z = (Real.pi / k) * (k * Real.log Z) := by field_simp [ne_of_gt hk] <;> ring _ ≤ Real.pi / k * M := hh have herror := (sieve_error_le_normalizedError hZ₂ hq hqlog).trans hZ₁'.2.le have hnormalized : ((primeProgression a (∏ p ∈ P, p) (Real.sqrt Z)).card : ℝ) * N ≤ Real.pi / k + 1 := by change _ ≤ (9 * Real.pi * Z ^ (1 / 16 : ℝ) + Real.pi * Z / (q ^ 2 * M) + 576 * Real.pi * (Real.sqrt Z / q + 1) * (Z ^ (1 / 16 : ℝ)) ^ 4) * N at hfiniteN change (9 * Real.pi * Z ^ (1 / 16 : ℝ) + 576 * Real.pi * (Real.sqrt Z / q + 1) * (Z ^ (1 / 16 : ℝ)) ^ 4) * N ≤ 1 at herror nlinarith [hfiniteN, hmain, herror] have hfinal := (le_div_iff₀ hN).mpr hnormalized change _ ≤ (Real.pi / k + 1) * Z / (q ^ 2 * Real.log Z) have heq : (Real.pi / k + 1) / N = (Real.pi / k + 1) * Z / (q ^ 2 * Real.log Z) := by dsimp [N] field_simp [ne_of_gt hq, ne_of_gt hL, ne_of_gt hZ₀] <;> ring exact hfinal.trans_eq heq /-- A finite residue family costs at most its cardinality; overlaps only improve the bound. -/ theorem primeProgression_biUnion_card_polylog (A : ℝ) (hA : 0 < A) : ∃ C Z₀ : ℝ, 0 < C ∧ 1 < Z₀ ∧ ∀ Z : ℝ, Z₀ ≤ Z → ∀ P : Finset ℕ, P.card ≤ 4 → (∀ p ∈ P, p.Prime ∧ p % 4 = 3) → (((∏ p ∈ P, p : ℕ) : ℝ) ≤ (Real.log Z) ^ A) → ∀ F : Finset GaussianInt, ((F.biUnion (fun a => primeProgression a (∏ p ∈ P, p) (Real.sqrt Z))).card : ℝ) ≤ (F.card : ℝ) * (C * Z / (((∏ p ∈ P, p : ℕ) : ℝ) ^ 2 * Real.log Z)) := by obtain ⟨C, Z₀, hC, hZ₀, hbound⟩ := primeProgression_card_polylog A hA refine ⟨C, Z₀, hC, hZ₀, fun Z hZ P hcard hP hq F => ?_⟩ calc _ ≤ ∑ a ∈ F, ((primeProgression a (∏ p ∈ P, p) (Real.sqrt Z)).card : ℝ) := by exact_mod_cast (Finset.card_biUnion_le : (F.biUnion (fun a => primeProgression a (∏ p ∈ P, p) (Real.sqrt Z))).card ≤ ∑ a ∈ F, (primeProgression a (∏ p ∈ P, p) (Real.sqrt Z)).card) _ ≤ ∑ _a ∈ F, C * Z / (((∏ p ∈ P, p : ℕ) : ℝ) ^ 2 * Real.log Z) := Finset.sum_le_sum (fun a _ => hbound Z hZ P hcard hP hq a) _ = _ := by simp end DistanceCounts.GaussianPrimeBounds end end BodyFile043 -- Source: DistanceCounts/LargeFlipCount.lean section BodyFile044 /-! A finite prime sieve for actual large conjugate-prime flips. -/ noncomputable section namespace DistanceCounts.LargeFlipCount open Finset GaussianMass GaussianDivisibility GaussianNorm GaussianResidues open GaussianProgressions GaussianSieve open scoped Classical /-- Actual nonzero vectors, with genuine prime and equal-norm flip witnesses. The witness is allowed to be the vector itself. -/ def largeFlipVectors (q : ℕ) (R Y T : ℝ) : Finset GaussianInt := ((gaussianDisk 0 R).erase 0).filter fun z => IsUnit (residue q z) ∧ ((normCircle z.norm.natAbs).card : ℝ) ≤ T ∧ ∃ π : GaussianInt, Prime π ∧ Y ≤ normMass π ∧ π ∣ z ∧ ∃ w ∈ normCircle z.norm.natAbs, (q : GaussianInt) ∣ z - w ∧ star π ∣ w lemma mem_largeFlipVectors (q : ℕ) (R Y T : ℝ) (z : GaussianInt) : z ∈ largeFlipVectors q R Y T ↔ z ≠ 0 ∧ ‖(z : ℂ)‖ ≤ R ∧ IsUnit (residue q z) ∧ ((normCircle z.norm.natAbs).card : ℝ) ≤ T ∧ ∃ π : GaussianInt, Prime π ∧ Y ≤ normMass π ∧ π ∣ z ∧ ∃ w ∈ normCircle z.norm.natAbs, (q : GaussianInt) ∣ z - w ∧ star π ∣ w := by simp [largeFlipVectors, mem_gaussianDisk, and_assoc] /-- Multiplication injects the smaller genuine norm circle into the larger one. -/ theorem normCircle_card_mul_le (π u : GaussianInt) (hπ : π ≠ 0) : (normCircle u.norm.natAbs).card ≤ (normCircle (π * u).norm.natAbs).card := by apply Finset.card_le_card_of_injOn (fun v => π * v) · intro v hv apply (mem_normCircle _ _).mpr simp only [Zsqrtd.norm_mul, Int.natAbs_mul, (mem_normCircle _ _).mp hv] · intro v _ w _ h exact mul_left_cancel₀ hπ h /-- The finite solutions of one ratio equation in the actual quotient. -/ def ratioResidues (q : ℕ) (hq : 0 < q) (u v : GaussianInt) : Finset (Residue q) := by letI : Finite (Residue q) := finite_residue q hq letI : Fintype {a : Residue q // a * residue q u = conjugate q a * residue q v} := Fintype.ofFinite _ exact (Finset.univ : Finset {a : Residue q // a * residue q u = conjugate q a * residue q v}).image Subtype.val lemma mem_ratioResidues (q : ℕ) (hq : 0 < q) (u v : GaussianInt) (a : Residue q) : a ∈ ratioResidues q hq u v ↔ a * residue q u = conjugate q a * residue q v := by letI : Finite (Residue q) := finite_residue q hq letI : Fintype {a : Residue q // a * residue q u = conjugate q a * residue q v} := Fintype.ofFinite _ dsimp only [ratioResidues] simp lemma ratioResidues_card (q : ℕ) (hq : 0 < q) (u v : GaussianInt) : (ratioResidues q hq u v).card = Nat.card {a : Residue q // a * residue q u = conjugate q a * residue q v} := by letI : Finite (Residue q) := finite_residue q hq letI : Fintype {a : Residue q // a * residue q u = conjugate q a * residue q v} := Fintype.ofFinite _ dsimp only [ratioResidues] rw [Finset.card_image_of_injective _ Subtype.val_injective, Finset.card_univ] exact Nat.card_eq_fintype_card.symm /-- Actual Gaussian lifts of the union of the equal-norm ratio fibers. -/ def ratioLifts (q : ℕ) (hq : 0 < q) (u : GaussianInt) : Finset GaussianInt := ((normCircle u.norm.natAbs).biUnion (ratioResidues q hq u)).image Quotient.out lemma ratioLifts_card_le (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime ∧ p % 4 = 3) (hq : 0 < ∏ p ∈ P, p) (u : GaussianInt) (hu : IsUnit (residue (∏ p ∈ P, p) u)) : (ratioLifts (∏ p ∈ P, p) hq u).card ≤ (∏ p ∈ P, p) * (normCircle u.norm.natAbs).card := by have hlocal (p : P) : crtReduction P (residue (∏ p ∈ P, p) u) p ≠ 0 := by have hunit := hu.map (reduce (Finset.dvd_prod_of_mem (fun p : ℕ => p) p.2)) exact (isUnit_iff_ne_zero_inert p.1 (hP p.1 p.2).1 (hP p.1 p.2).2 _).mp hunit calc _ ≤ ((normCircle u.norm.natAbs).biUnion (ratioResidues (∏ p ∈ P, p) hq u)).card := Finset.card_image_le _ ≤ ∑ v ∈ normCircle u.norm.natAbs, (ratioResidues (∏ p ∈ P, p) hq u v).card := Finset.card_biUnion_le _ ≤ ∑ _v ∈ normCircle u.norm.natAbs, (∏ p ∈ P, p) := by apply Finset.sum_le_sum intro v _ rw [ratioResidues_card] exact card_ratio_fiber_product P (fun p hp => (hP p hp).1) (fun p hp => (hP p hp).2) _ _ hlocal _ = _ := by simp [Nat.mul_comm] /-- Cofactors retain the unit and representation-count restrictions of the vector. -/ def cofactors (q : ℕ) (R Y T : ℝ) : Finset GaussianInt := (representatives (R ^ 2 / Y)).filter fun u => IsUnit (residue q u) ∧ ((normCircle u.norm.natAbs).card : ℝ) ≤ T /-- Each prime is counted in genuine lifted progressions at its exact norm scale. -/ def primeCandidates (q : ℕ) (hq : 0 < q) (R : ℝ) (u : GaussianInt) : Finset GaussianInt := (ratioLifts q hq u).biUnion fun a => primeProgression a q (Real.sqrt (R ^ 2 / normMass u)) /-- All cofactor, norm, radius, representation, and quotient facts follow from an actual flip. No residue family is supplied as a hypothesis. -/ theorem largeFlip_factorization {q : ℕ} {R Y T : ℝ} (hR : 0 ≤ R) (hY : 0 < Y) {z : GaussianInt} (hz : z ∈ largeFlipVectors q R Y T) : ∃ π u v : GaussianInt, Prime π ∧ z = π * u ∧ u ∈ cofactors q R Y T ∧ v ∈ normCircle u.norm.natAbs ∧ normMass π ≤ R ^ 2 / normMass u ∧ residue q π * residue q u = conjugate q (residue q π) * residue q v := by obtain ⟨hz0, hzR, hzunit, hzT, π, hπ, hYπ, ⟨u, hzu⟩, w, hw, hzw, ⟨v, hwv⟩⟩ := (mem_largeFlipVectors q R Y T z).mp hz have hu0 : u ≠ 0 := by intro h; simp [h] at hzu; exact hz0 hzu have huN : 0 < normMass u := lt_of_lt_of_le zero_lt_one (one_le_normMass hu0) have hπN : 0 < π.norm.natAbs := Int.natAbs_pos.mpr (GaussianInt.norm_eq_zero.not.mpr hπ.ne_zero) have hnorm : π.norm.natAbs * v.norm.natAbs = π.norm.natAbs * u.norm.natAbs := by have h := (mem_normCircle _ _).mp hw simpa only [hwv, hzu, Zsqrtd.norm_mul, Zsqrtd.norm_conj, Int.natAbs_mul] using h have hvu : v.norm.natAbs = u.norm.natAbs := Nat.eq_of_mul_eq_mul_left hπN hnorm have hzN : normMass z ≤ R ^ 2 := by rw [normMass_eq_sq_norm] exact (sq_le_sq₀ (norm_nonneg (z : ℂ)) hR).mpr hzR have hprod : normMass π * normMass u ≤ R ^ 2 := by simpa only [hzu, normMass_mul] using hzN have huY : normMass u ≤ R ^ 2 / Y := by apply (le_div_iff₀ hY).mpr exact (by nlinarith [mul_le_mul_of_nonneg_right hYπ huN.le] : normMass u * Y ≤ R ^ 2) have huunit : IsUnit (residue q u) := by apply isUnit_of_mul_isUnit_right (x := residue q π) simpa only [hzu, residue, map_mul] using hzunit have huT : ((normCircle u.norm.natAbs).card : ℝ) ≤ T := by have hh : ((normCircle u.norm.natAbs).card : ℝ) ≤ (normCircle (π * u).norm.natAbs).card := by exact_mod_cast normCircle_card_mul_le π u hπ.ne_zero exact hh.trans (by simpa only [hzu] using hzT) refine ⟨π, u, v, hπ, hzu, ?_, (mem_normCircle _ _).mpr hvu, (le_div_iff₀ huN).mpr hprod, ?_⟩ · exact Finset.mem_filter.mpr ⟨(mem_representatives (div_nonneg (sq_nonneg R) hY.le) u).mpr ⟨hu0, huY⟩, huunit, huT⟩ · have he : residue q z = residue q w := Ideal.Quotient.eq.2 (Ideal.mem_span_singleton.2 hzw) rw [conjugate_residue] simpa only [hzu, hwv, residue, map_mul] using he /-- Explicit incidence inclusion into products of actual prime progression populations. -/ theorem largeFlipVectors_subset (q : ℕ) (hq : 0 < q) {R Y T : ℝ} (hR : 0 ≤ R) (hY : 0 < Y) : largeFlipVectors q R Y T ⊆ (cofactors q R Y T).biUnion fun u => (primeCandidates q hq R u).image (fun π => π * u) := by intro z hz obtain ⟨π, u, v, hπ, rfl, hu, hv, hπR, he⟩ := largeFlip_factorization hR hY hz apply Finset.mem_biUnion.mpr refine ⟨u, hu, Finset.mem_image.mpr ⟨π, ?_, rfl⟩⟩ apply Finset.mem_biUnion.mpr let a : GaussianInt := Quotient.out (residue q π) have ha : a ∈ ratioLifts q hq u := by letI : DecidableEq (Residue q) := fun a b => Classical.propDecidable (a = b) apply Finset.mem_image.mpr refine ⟨residue q π, Finset.mem_biUnion.mpr ⟨v, hv, ?_⟩, rfl⟩ exact (mem_ratioResidues q hq u v _).mpr he refine ⟨a, ha, Finset.mem_filter.mpr ⟨?_, hπ⟩⟩ apply (mem_progression a π q _).mpr constructor · simp only [dist_zero_right, gaussian_complex_norm] exact Real.sqrt_le_sqrt hπR · apply Ideal.mem_span_singleton.1 apply Ideal.Quotient.eq.1 exact (Ideal.Quotient.mk_out (residue q π)).symm /-- Uniform finite sieve bound, prior to any estimate of the logarithmic sum. -/ theorem largeFlipVectors_card_polylog (A : ℝ) (hA : 0 < A) : ∃ C Z₀ : ℝ, 0 < C ∧ 1 < Z₀ ∧ ∀ P : Finset ℕ, P.card ≤ 4 → (∀ p ∈ P, p.Prime ∧ p % 4 = 3) → ∀ R Y T : ℝ, 0 ≤ R → max Z₀ 2 ≤ Y → 0 ≤ T → (((∏ p ∈ P, p : ℕ) : ℝ) ≤ (Real.log Y) ^ A) → ((largeFlipVectors (∏ p ∈ P, p) R Y T).card : ℝ) ≤ C * (T / ((∏ p ∈ P, p : ℕ) : ℝ)) * R ^ 2 * ∑ u ∈ representatives (R ^ 2 / Y), 1 / (normMass u * Real.log (R ^ 2 / normMass u)) := by obtain ⟨C, Z₀, hC, hZ₀, hbound⟩ := GaussianPrimeBounds.primeProgression_biUnion_card_polylog A hA refine ⟨C, Z₀, hC, hZ₀, ?_⟩ intro P hfour hP R Y T hR hY hT hqlog let q : ℕ := ∏ p ∈ P, p have hq : 0 < q := Finset.prod_pos fun p hp => (hP p hp).1.pos have hqR : (0 : ℝ) < q := by exact_mod_cast hq have hY₁ : 1 < Y := lt_of_lt_of_le hZ₀ ((le_max_left _ _).trans hY) have hY₀ : 0 < Y := zero_lt_one.trans hY₁ have hscale (u : GaussianInt) (hu : u ∈ representatives (R ^ 2 / Y)) : 0 < normMass u ∧ Y ≤ R ^ 2 / normMass u := by obtain ⟨hu0, huR⟩ := (mem_representatives (div_nonneg (sq_nonneg R) hY₀.le) u).mp hu have huN : 0 < normMass u := lt_of_lt_of_le zero_lt_one (one_le_normMass hu0) refine ⟨huN, (le_div_iff₀ huN).mpr ?_⟩ have hh := (le_div_iff₀ hY₀).mp huR have normMass_eq_natNorm : normMass u = (u.norm.natAbs : ℝ) := rfl simpa only [normMass_eq_natNorm, mul_comm] using hh have hprime (u : GaussianInt) (hu : u ∈ cofactors q R Y T) : ((primeCandidates q hq R u).card : ℝ) ≤ C * (T / (q : ℝ)) * R ^ 2 * (1 / (normMass u * Real.log (R ^ 2 / normMass u))) := by obtain ⟨huR, huunit, huT⟩ := Finset.mem_filter.mp hu obtain ⟨huN, huY⟩ := hscale u huR have hZ : Z₀ ≤ R ^ 2 / normMass u := ((le_max_left _ _).trans hY).trans huY have hlog : 0 < Real.log (R ^ 2 / normMass u) := Real.log_pos (hY₁.trans_le huY) have hqZ : (q : ℝ) ≤ (Real.log (R ^ 2 / normMass u)) ^ A := hqlog.trans (Real.rpow_le_rpow (Real.log_pos hY₁).le (Real.log_le_log hY₀ huY) hA.le) have hf : ((ratioLifts q hq u).card : ℝ) ≤ (q : ℝ) * T := by have hh : ((ratioLifts q hq u).card : ℝ) ≤ (q : ℝ) * ((normCircle u.norm.natAbs).card : ℝ) := by exact_mod_cast ratioLifts_card_le P hP hq u huunit exact hh.trans (mul_le_mul_of_nonneg_left huT hqR.le) calc _ ≤ ((ratioLifts q hq u).card : ℝ) * (C * (R ^ 2 / normMass u) / ((q : ℝ) ^ 2 * Real.log (R ^ 2 / normMass u))) := hbound _ hZ P hfour hP hqZ (ratioLifts q hq u) _ ≤ ((q : ℝ) * T) * (C * (R ^ 2 / normMass u) / ((q : ℝ) ^ 2 * Real.log (R ^ 2 / normMass u))) := mul_le_mul_of_nonneg_right hf (by positivity) _ = _ := by field_simp [ne_of_gt hqR, ne_of_gt huN, ne_of_gt hlog] <;> ring have hnonneg (u : GaussianInt) (hu : u ∈ representatives (R ^ 2 / Y)) : 0 ≤ C * (T / (q : ℝ)) * R ^ 2 * (1 / (normMass u * Real.log (R ^ 2 / normMass u))) := by obtain ⟨huN, huY⟩ := hscale u hu have : 0 < Real.log (R ^ 2 / normMass u) := Real.log_pos (hY₁.trans_le huY) positivity calc _ ≤ (((cofactors q R Y T).biUnion fun u => (primeCandidates q hq R u).image (fun π => π * u)).card : ℝ) := by exact_mod_cast Finset.card_le_card (largeFlipVectors_subset q hq hR hY₀) _ ≤ ∑ u ∈ cofactors q R Y T, (((primeCandidates q hq R u).image (fun π => π * u)).card : ℝ) := by exact_mod_cast (Finset.card_biUnion_le : ((cofactors q R Y T).biUnion fun u => (primeCandidates q hq R u).image (fun π => π * u)).card ≤ _) _ ≤ ∑ u ∈ cofactors q R Y T, ((primeCandidates q hq R u).card : ℝ) := by apply Finset.sum_le_sum intro u _ exact_mod_cast (Finset.card_image_le : ((primeCandidates q hq R u).image (fun π => π * u)).card ≤ _) _ ≤ ∑ u ∈ cofactors q R Y T, C * (T / (q : ℝ)) * R ^ 2 * (1 / (normMass u * Real.log (R ^ 2 / normMass u))) := Finset.sum_le_sum hprime _ ≤ ∑ u ∈ representatives (R ^ 2 / Y), C * (T / (q : ℝ)) * R ^ 2 * (1 / (normMass u * Real.log (R ^ 2 / normMass u))) := Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _) (fun u hu _ => hnonneg u hu) _ = _ := by rw [← Finset.mul_sum] end DistanceCounts.LargeFlipCount end end BodyFile044 -- Source: DistanceCounts/HighCollisionCover.lean section BodyFile045 /-! The exact arithmetic cover of genuine unit-residue collisions. -/ noncomputable section namespace DistanceCounts.HighCollisionCover open Finset GaussianMass GaussianDivisibility GaussianNorm GaussianPrimeWeight open GaussianSmoothPart SmallFlipLattice LargeFlipCount open scoped Classical /-- Actual nonzero vectors with a distinct equal-norm partner in the same disk and the same unit residue class. -/ def collisionVectors (q : ℕ) (R : ℝ) : Finset GaussianInt := ((gaussianDisk 0 R).erase 0).filter fun z => IsUnit (residue q z) ∧ ∃ w ∈ gaussianDisk 0 R, w ≠ z ∧ z.norm = w.norm ∧ residue q z = residue q w lemma mem_collisionVectors (q : ℕ) (R : ℝ) (z : GaussianInt) : z ∈ collisionVectors q R ↔ z ≠ 0 ∧ ‖(z : ℂ)‖ ≤ R ∧ IsUnit (residue q z) ∧ ∃ w ∈ gaussianDisk 0 R, w ≠ z ∧ z.norm = w.norm ∧ residue q z = residue q w := by simp [collisionVectors, mem_gaussianDisk, and_assoc] /-- The actual excessive-representation population, with a strict cutoff. -/ def excessiveRepresentations (R T : ℝ) : Finset GaussianInt := (representatives (R ^ 2)).filter fun z => T < ((normCircle z.norm.natAbs).card : ℝ) /-- A lifted inverse gives Bezout coefficients with the actual modulus. -/ theorem isCoprime_of_unit_residue {q : ℕ} {z : GaussianInt} (hz : IsUnit (residue q z)) : IsCoprime (q : GaussianInt) z := by obtain ⟨a, ha⟩ := isUnit_iff_exists_inv'.mp hz obtain ⟨b, hb⟩ := Ideal.Quotient.mk_surjective a have he : residue q (b * z) = residue q 1 := by simpa only [residue, map_mul, map_one, hb] using ha obtain ⟨c, hc⟩ := Ideal.mem_span_singleton.mp (Ideal.Quotient.eq.mp he) refine ⟨-c, b, ?_⟩ linear_combination hc /-- Unit residues are coprime to the genuine common factor, not merely to an assumed primitive cofactor. -/ theorem isCoprime_gcd_of_unit_residue {q : ℕ} {z w : GaussianInt} (hz : IsUnit (residue q z)) : IsCoprime (q : GaussianInt) (EuclideanDomain.gcd z w) := (isCoprime_of_unit_residue hz).of_isCoprime_of_dvd_right (EuclideanDomain.gcd_dvd_left z w) /-- Inert prime products are positive and odd, including the empty product. -/ theorem inert_product_pos_odd (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime ∧ p % 4 = 3) : 0 < ∏ p ∈ P, p ∧ Odd (∏ p ∈ P, p) := by refine ⟨Finset.prod_pos (fun p hp => (hP p hp).1.pos), ?_⟩ revert hP induction P using Finset.induction_on with | empty => intro _; simp | @insert p P hp ih => intro hP rw [Finset.prod_insert hp] have hpodd : Odd p := Nat.odd_iff.mpr (by have := (hP p (Finset.mem_insert_self p P)).2 omega) exact hpodd.mul (ih (fun r hr => hP r (Finset.mem_insert_of_mem hr))) /-- Divisibility of nonzero associate classes is detected by every actual prime multiplicity. -/ private lemma dvd_of_counts_le {a b : Associates GaussianInt} (ha : a ≠ 0) (hb : b ≠ 0) (h : ∀ p : Associates GaussianInt, Irreducible p → p.count a.factors ≤ p.count b.factors) : a ∣ b := by apply Associates.factors_le.mp obtain ⟨sa, hsa⟩ := Associates.factors_eq_some_iff_ne_zero.mpr ha obtain ⟨sb, hsb⟩ := Associates.factors_eq_some_iff_ne_zero.mpr hb rw [hsa, hsb, WithTop.coe_le_coe] apply Multiset.le_iff_count.mpr intro p have hp := h p.1 p.2 simpa only [hsa, hsb, Associates.count_some p.2] using hp /-- Full prime-power multiplicities are retained: any actual divisor supported on the cutoff classes divides the genuine small-prime part. -/ theorem divisor_dvd_smallPartY {Y : ℝ} {v z : GaussianInt} (hv : v ≠ 0) (hz : z ≠ 0) (hvz : v ∣ z) (hsupport : ∀ p : Associates GaussianInt, Prime p → p ∣ Associates.mk v → p ∈ primeClassesY Y) : Associates.mk v ∣ smallPartY Y z := by apply dvd_of_counts_le (Associates.mk_ne_zero.mpr hv) (smallPartY_ne_zero Y z) intro p hp by_cases hc : p.count (Associates.mk v).factors = 0 · rw [hc] exact Nat.zero_le _ have hprime : Prime p := UniqueFactorizationMonoid.irreducible_iff_prime.mp hp have hmem : p ∈ primeClassesY Y := hsupport p hprime (Associates.le_of_count_ne_zero (Associates.mk_ne_zero.mpr hv) hp hc) have hcount : p.count (Associates.mk v).factors ≤ valuation p z := Associates.count_le_count_of_le (Associates.mk_ne_zero.mpr hz) hp (Associates.mk_dvd_mk.mpr hvz) have hpow : p ^ valuation p z ∣ smallPartY Y z := Finset.dvd_prod_of_mem (fun r => r ^ valuation r z) hmem have hbound : valuation p z ≤ p.count (smallPartY Y z).factors := (Associates.prime_pow_dvd_iff_le (smallPartY_ne_zero Y z) hp).mp hpow exact hcount.trans hbound /-- If the primitive factor exceeds the actual smooth part, it has an actual large Gaussian prime divisor. No squarefree restriction occurs. -/ theorem exists_large_prime_divisor {Y S : ℝ} (hY : 0 ≤ Y) {v z : GaussianInt} (hv : v ≠ 0) (hz : z ≠ 0) (hvz : v ∣ z) (hSv : S < normMass v) (hzS : (classNorm (smallPartY Y z) : ℝ) ≤ S) : ∃ π : GaussianInt, Prime π ∧ Y < normMass π ∧ π ∣ v := by have hex : ∃ p : Associates GaussianInt, Prime p ∧ p ∣ Associates.mk v ∧ p ∉ primeClassesY Y := by by_contra h have hs : ∀ p : Associates GaussianInt, Prime p → p ∣ Associates.mk v → p ∈ primeClassesY Y := by intro p hp hd by_contra hn exact h ⟨p, hp, hd, hn⟩ have hd := divisor_dvd_smallPartY hv hz hvz hs have hn : normMass v ≤ (classNorm (smallPartY Y z) : ℝ) := by have hn' := classNorm_le_of_dvd (smallPartY_ne_zero Y z) hd rw [classNorm_mk] at hn' change (v.norm.natAbs : ℝ) ≤ _ exact_mod_cast hn' exact (not_lt_of_ge (hn.trans hzS)) hSv obtain ⟨p, hp, hd, hnot⟩ := hex obtain ⟨π, rfl⟩ := Associates.mk_surjective p refine ⟨π, Associates.prime_mk.mp hp, ?_, Associates.mk_dvd_mk.mp hd⟩ have hlarge : Y < (classNorm (Associates.mk π) : ℝ) := by by_contra h exact hnot ((mem_primeClassesY hY _).mpr ⟨hp, le_of_not_gt h⟩) exact hlarge /-- The concrete four-set cover follows solely from collision, gcd, unit, valuation, and norm facts. The modulus may have any number of inert prime factors; in particular this applies to the at-most-four-prime sieve moduli. -/ theorem collisionVectors_subset (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime ∧ p % 4 = 3) {R Y S T : ℝ} (hR : 0 ≤ R) (hY : 0 ≤ Y) : collisionVectors (∏ p ∈ P, p) R ⊆ excessiveRepresentations R T ∪ GaussianSmoothPart.exceptional R Y S ∪ smallFlipDivisibleVectors (∏ p ∈ P, p) S R ∪ largeFlipVectors (∏ p ∈ P, p) R Y T := by intro z hz obtain ⟨hz0, hzR, hzunit, w, _hwR, hwz, hn, hres⟩ := (mem_collisionVectors _ _ _).mp hz have hzN : normMass z ≤ R ^ 2 := by rw [normMass_eq_sq_norm] exact (sq_le_sq₀ (norm_nonneg (z : ℂ)) hR).mpr hzR have hzrep : z ∈ representatives (R ^ 2) := (mem_representatives (sq_nonneg R) z).mpr ⟨hz0, hzN⟩ by_cases hzT : T < ((normCircle z.norm.natAbs).card : ℝ) · exact Finset.mem_union_left _ (Finset.mem_union_left _ (Finset.mem_union_left _ (Finset.mem_filter.mpr ⟨hzrep, hzT⟩))) by_cases hzS : S < (classNorm (smallPartY Y z) : ℝ) · exact Finset.mem_union_left _ (Finset.mem_union_left _ (Finset.mem_union_right _ (Finset.mem_filter.mpr ⟨hzrep, hzS⟩))) obtain ⟨hq, hqodd⟩ := inert_product_pos_odd P hP have hw0 : w ≠ 0 := by intro hw apply hz0 apply GaussianInt.norm_eq_zero.mp simpa only [hw, Zsqrtd.norm_zero] using hn have hd : ((∏ p ∈ P, p : ℕ) : GaussianInt) ∣ z - w := Ideal.mem_span_singleton.mp (Ideal.Quotient.eq.mp hres) obtain ⟨g, v, u, _hgcd, _hvdiv, _hg, hv, hzv, hwv, _hprim, htrans⟩ := PrimitiveNormPairs.collision_decomposition hq hqodd hz0 hw0 hn hwz hd (isCoprime_gcd_of_unit_residue hzunit) have hvz : v ∣ z := by rw [hzv] exact dvd_mul_left v g by_cases hvS : normMass v ≤ S · have hvr : ‖(v : ℂ)‖ ≤ Real.sqrt S := by rw [normMass_eq_sq_norm] at hvS exact (Real.le_sqrt (norm_nonneg _) (le_trans (sq_nonneg _) hvS)).mpr hvS have hvsmall : v ∈ smallFlipVectors (∏ p ∈ P, p) S := (mem_smallFlipVectors _ _ _).mpr ⟨hv, hvr, htrans⟩ exact Finset.mem_union_left _ (Finset.mem_union_right _ ((mem_smallFlipDivisibleVectors _ _ _ _).mpr ⟨hz0, hzR, v, hvsmall, hvz⟩)) · obtain ⟨π, hπ, hYπ, hπv⟩ := exists_large_prime_divisor hY hv hz0 hvz (lt_of_not_ge hvS) (le_of_not_gt hzS) have hstar : star π ∣ star v := by obtain ⟨a, ha⟩ := hπv exact ⟨star a, by simp only [ha, star_mul, mul_comm]⟩ have hπw : star π ∣ w := by rw [hwv] exact dvd_mul_of_dvd_right hstar (g * (u : GaussianInt)) apply Finset.mem_union_right apply (mem_largeFlipVectors _ _ _ _ _).mpr refine ⟨hz0, hzR, hzunit, le_of_not_gt hzT, π, hπ, hYπ.le, hπv.trans hvz, w, ?_, hd, hπw⟩ exact (mem_normCircle _ _).mpr (congrArg Int.natAbs hn.symm) end DistanceCounts.HighCollisionCover end end BodyFile045 -- Source: DistanceCounts/ResidueExceptions.lean section BodyFile046 noncomputable section namespace DistanceCounts.ResidueExceptions open Finset open scoped Classical /-- The actual colliding vectors in one canonical quotient class. -/ def collisionFiber (q : ℕ) (R : ℝ) (a : GaussianResidues.Residue q) : Finset GaussianInt := (HighCollisionCover.collisionVectors q R).filter (fun z => GaussianNorm.residue q z = a) lemma mem_collisionFiber (q : ℕ) (R : ℝ) (a : GaussianResidues.Residue q) (z : GaussianInt) : z ∈ collisionFiber q R a ↔ z ∈ HighCollisionCover.collisionVectors q R ∧ GaussianNorm.residue q z = a := by exact mem_filter /-- Every actual collision belongs to exactly one residue fiber. -/ theorem sum_collisionFiber_card (q : ℕ) (hq : 0 < q) (R : ℝ) : ∑ a ∈ LowPalette.allResidues q hq, (collisionFiber q R a).card = (HighCollisionCover.collisionVectors q R).card := by exact (card_eq_sum_card_fiberwise (f := GaussianNorm.residue q) (s := HighCollisionCover.collisionVectors q R) (t := LowPalette.allResidues q hq) (fun z _ => LowPalette.mem_allResidues q hq (GaussianNorm.residue q z))).symm theorem sum_collisionFiber_card_real (q : ℕ) (hq : 0 < q) (R : ℝ) : ∑ a ∈ LowPalette.allResidues q hq, ((collisionFiber q R a).card : ℝ) = ((HighCollisionCover.collisionVectors q R).card : ℝ) := by exact_mod_cast sum_collisionFiber_card q hq R /-- The denominator `q²` counts all actual quotient classes. -/ theorem allResidues_card (q : ℕ) (hq : 0 < q) : (LowPalette.allResidues q hq).card = q ^ 2 := by letI : Fintype (GaussianResidues.Residue q) := @Fintype.ofFinite _ (GaussianResidues.finite_residue q hq) change Fintype.card (GaussianResidues.Residue q) = q ^ 2 rw [← Nat.card_eq_fintype_card, GaussianResidues.card_residue] /-- Low residues are exceptional for their actual distinct-norm palette. -/ def badLow (q : ℕ) (hq : 0 < q) (R H : ℝ) : Finset (GaussianResidues.Residue q) := (LowPalette.allResidues q hq).filter (fun a => H < ((LowPalette.normPalette a R).card : ℝ)) /-- High residues are exceptional for their actual colliding-vector population. -/ def badHigh (q : ℕ) (hq : 0 < q) (R H : ℝ) : Finset (GaussianResidues.Residue q) := (LowPalette.allResidues q hq).filter (fun a => H < ((collisionFiber q R a).card : ℝ)) lemma mem_badLow (q : ℕ) (hq : 0 < q) (R H : ℝ) (a : GaussianResidues.Residue q) : a ∈ badLow q hq R H ↔ H < ((LowPalette.normPalette a R).card : ℝ) := by simp [badLow, LowPalette.mem_allResidues] lemma mem_badHigh (q : ℕ) (hq : 0 < q) (R H : ℝ) (a : GaussianResidues.Residue q) : a ∈ badHigh q hq R H ↔ H < ((collisionFiber q R a).card : ℝ) := by simp [badHigh, LowPalette.mem_allResidues] lemma palette_card_le_of_not_badLow {q : ℕ} {hq : 0 < q} {R H : ℝ} {a : GaussianResidues.Residue q} (ha : a ∉ badLow q hq R H) : ((LowPalette.normPalette a R).card : ℝ) ≤ H := le_of_not_gt (fun h => ha ((mem_badLow q hq R H a).mpr h)) lemma collisionFiber_card_le_of_not_badHigh {q : ℕ} {hq : 0 < q} {R H : ℝ} {a : GaussianResidues.Residue q} (ha : a ∉ badHigh q hq R H) : ((collisionFiber q R a).card : ℝ) ≤ H := le_of_not_gt (fun h => ha ((mem_badHigh q hq R H a).mpr h)) /-- Finite Markov inequality, proved directly from the actual nonnegative sum. -/ private theorem card_filter_mul_le_sum {α : Type*} (s : Finset α) (f : α → ℝ) (hf : ∀ a ∈ s, 0 ≤ f a) (H : ℝ) : ((s.filter (fun a => H < f a)).card : ℝ) * H ≤ ∑ a ∈ s, f a := by calc _ = ∑ _a ∈ s.filter (fun a => H < f a), H := by simp _ ≤ ∑ a ∈ s.filter (fun a => H < f a), f a := sum_le_sum (fun a ha => (mem_filter.mp ha).2.le) _ ≤ ∑ a ∈ s, f a := sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (fun a ha _ => hf a ha) /-- No distribution premise is needed; even the threshold need not be positive. -/ theorem badLow_card_mul_le (q : ℕ) (hq : 0 < q) (R H : ℝ) : ((badLow q hq R H).card : ℝ) * H ≤ LowPalette.aggregate q hq R := by exact card_filter_mul_le_sum (LowPalette.allResidues q hq) (fun a => ((LowPalette.normPalette a R).card : ℝ)) (fun _ _ => Nat.cast_nonneg _) H theorem badHigh_card_mul_le (q : ℕ) (hq : 0 < q) (R H : ℝ) : ((badHigh q hq R H).card : ℝ) * H ≤ ((HighCollisionCover.collisionVectors q R).card : ℝ) := by have h := card_filter_mul_le_sum (LowPalette.allResidues q hq) (fun a => ((collisionFiber q R a).card : ℝ)) (fun _ _ => Nat.cast_nonneg _) H rw [sum_collisionFiber_card_real] at h exact h /-- Cancellation uses the positive threshold, never the error rate. -/ private theorem normalized_markov {B A C Q L τ R : ℝ} (hC : 0 < C) (hQ : 0 < Q) (hL : 0 < L) (hτ : 0 < τ) (hR : R = C * Q * L) (h : B * (τ * L ^ 2) ≤ A) : B / Q ^ 2 ≤ C ^ 2 * A / R ^ 2 / τ := by have hH : 0 < τ * L ^ 2 := mul_pos hτ (sq_pos_of_pos hL) calc B / Q ^ 2 ≤ (A / (τ * L ^ 2)) / Q ^ 2 := div_le_div_of_nonneg_right ((le_div_iff₀ hH).mpr h) (sq_nonneg Q) _ = C ^ 2 * A / R ^ 2 / τ := by rw [hR] field_simp [hC.ne', hQ.ne', hL.ne', hτ.ne'] <;> ring /-- The precise low-residue fraction at the actual coarse radius. -/ theorem badLow_normalized (q : ℕ) (hq : 0 < q) {C L τ R : ℝ} (hC : 0 < C) (hL : 0 < L) (hτ : 0 < τ) (hR : R = C * (q : ℝ) * L) : ((badLow q hq R (τ * L ^ 2)).card : ℝ) / (q : ℝ) ^ 2 ≤ C ^ 2 * LowPalette.aggregate q hq R / R ^ 2 / τ := by exact normalized_markov hC (by exact_mod_cast hq) hL hτ hR (badLow_card_mul_le q hq R (τ * L ^ 2)) /-- The precise high-residue fraction, using the actual collision population. -/ theorem badHigh_normalized (q : ℕ) (hq : 0 < q) {C L τ R : ℝ} (hC : 0 < C) (hL : 0 < L) (hτ : 0 < τ) (hR : R = C * (q : ℝ) * L) : ((badHigh q hq R (τ * L ^ 2)).card : ℝ) / (q : ℝ) ^ 2 ≤ C ^ 2 * ((HighCollisionCover.collisionVectors q R).card : ℝ) / R ^ 2 / τ := by exact normalized_markov hC (by exact_mod_cast hq) hL hτ hR (badHigh_card_mul_le q hq R (τ * L ^ 2)) /-- Actual unit classes whose oblique projection vanishes. -/ def badProjectedUnits (q : ℕ) (hq : 0 < q) (L : ZMod q) : Finset (GaussianResidues.Residue q) := (LowPalette.allResidues q hq).filter fun a => IsUnit a ∧ L * (GaussianResidues.coordinates q a).1 + (GaussianResidues.coordinates q a).2 = 0 lemma mem_badProjectedUnits (q : ℕ) (hq : 0 < q) (L : ZMod q) (a : GaussianResidues.Residue q) : a ∈ badProjectedUnits q hq L ↔ IsUnit a ∧ L * (GaussianResidues.coordinates q a).1 + (GaussianResidues.coordinates q a).2 = 0 := by simp [badProjectedUnits, LowPalette.mem_allResidues] /-- The unit restriction can only reduce the actual linear-fiber cardinality. -/ theorem badProjectedUnits_card_le (p : ℕ) (hp : p.Prime) (L : ZMod p) : (badProjectedUnits p hp.pos L).card ≤ p := by letI : Finite (GaussianResidues.Residue p) := GaussianResidues.finite_residue p hp.pos let f : {a // a ∈ badProjectedUnits p hp.pos L} → {a : GaussianResidues.Residue p // L * (GaussianResidues.coordinates p a).1 + (GaussianResidues.coordinates p a).2 = 0} := fun a => ⟨a.1, ((mem_badProjectedUnits p hp.pos L a.1).mp a.2).2⟩ have hf : Function.Injective f := by intro a b hab exact Subtype.ext (congrArg (fun x : {a : GaussianResidues.Residue p // L * (GaussianResidues.coordinates p a).1 + (GaussianResidues.coordinates p a).2 = 0} => x.1) hab) have h := Nat.card_le_card_of_injective f hf rw [Nat.card_eq_finsetCard] at h exact h.trans (GaussianResidues.card_bad_projection_prime p hp L) end DistanceCounts.ResidueExceptions end end BodyFile046 -- Source: DistanceCounts/CoarseConditions.lean section BodyFile047 /-! Actual finite arithmetic conditions used by the geometric coarse configuration. -/ noncomputable section namespace DistanceCounts.CoarseConditions open CoarseGrid PairModulus /-- One disk contains every scaled difference for a fixed pair of blocks. -/ def pairRadius {t : ℕ} (L : ℕ) (p : Fin t ⊕ Fin t → ℕ) (b c : Fin t × Fin t) : ℝ := 6 * (modulus p b c : ℝ) * L /-- The canonical class of the signed offset numerator; grid terms do not affect it. -/ def pairResidue {t : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (b c : Fin t × Fin t) : GaussianResidues.Residue (modulus p b c) := GaussianNorm.residue (modulus p b c) (numerator p z b c) /-- These are actual palette and collision-fiber cardinalities, not a coarse-count assumption. -/ def PaletteBounds (s L : ℕ) (p : Fin (2 * s) ⊕ Fin (2 * s) → ℕ) (z : Fin (2 * s) ⊕ Fin (2 * s) → GaussianInt) (ε : ℝ) : Prop := ∀ b c : Fin (2 * s) × Fin (2 * s), if (c.1.val, c.2.val) ∈ DistanceCounts.highTargets s b.1.val b.2.val then ((ResidueExceptions.collisionFiber (modulus p b c) (pairRadius L p b c) (pairResidue p z b c)).card : ℝ) ≤ ε * (L : ℝ) ^ 2 else ((LowPalette.normPalette (pairResidue p z b c) (pairRadius L p b c)).card : ℝ) ≤ ε * (L : ℝ) ^ 2 /-- Shared contract for actual arithmetic selection and actual distance counting. -/ structure Admissible (s L : ℕ) (p : Fin (2 * s) ⊕ Fin (2 * s) → ℕ) (z : Fin (2 * s) ⊕ Fin (2 * s) → GaussianInt) (ε : ℝ) : Prop where prime : ∀ i, (p i).Prime inert : ∀ i, p i % 4 = 3 injective : Function.Injective p units : ∀ i, IsUnit (GaussianNorm.residue (p i) (z i)) bounded : PairModulus.BoundedOffsets p z projection : ∀ i, ¬(p i : ℤ) ∣ OffsetSeparation.projectionNumerator (L : ℤ) (z i) nonneg : 0 ≤ ε palettes : PaletteBounds s L p z ε end DistanceCounts.CoarseConditions end end BodyFile047 -- Source: DistanceCounts/PrimeScaleFamilies.lean section BodyFile048 noncomputable section open Filter Finset open scoped Topology Classical namespace DistanceCounts.PrimeScaleFamilies lemma tendsto_log_nat : Tendsto (fun L : ℕ => Real.log L) atTop atTop := Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop lemma tendsto_loglog_nat : Tendsto (fun L : ℕ => Real.log (Real.log L)) atTop atTop := Real.tendsto_log_atTop.comp tendsto_log_nat private def primeThreshold : ℕ := max 1 (Classical.choose (eventually_atTop.1 PrimeProgressions.eventually_exists_prime_three_mod_four)) private lemma prime_interval (n : ℕ) (hn : primeThreshold ≤ n) : ∃ p : ℕ, p.Prime ∧ p % 4 = 3 ∧ n ≤ p ∧ p < 2 * n := Classical.choose_spec (eventually_atTop.1 PrimeProgressions.eventually_exists_prime_three_mod_four) n ((le_max_right _ _).trans hn) /-- One fixed injective rank is used even when several requested exponents coincide. -/ def rank {I : Type*} [Fintype I] (i : I) : ℕ := (Fintype.equivFin I i).val lemma rank_injective {I : Type*} [Fintype I] : Function.Injective (rank (I := I)) := by intro i j h apply (Fintype.equivFin I).injective exact Fin.ext h private def base (w : ℝ) (L : ℕ) : ℕ := max primeThreshold ⌊(Real.log L) ^ w⌋₊ private def endpoint {I : Type*} [Fintype I] (w : I → ℝ) (L : ℕ) (i : I) : ℕ := 2 ^ rank i * base (w i) L private lemma endpoint_large {I : Type*} [Fintype I] (w : I → ℝ) (L : ℕ) (i : I) : primeThreshold ≤ endpoint w L i := by have hp : 1 ≤ (2 : ℕ) ^ rank i := by have : 0 < (2 : ℕ) ^ rank i := by positivity omega have hb : primeThreshold ≤ base (w i) L := le_max_left _ _ apply hb.trans change base (w i) L ≤ 2 ^ rank i * base (w i) L simpa only [one_mul] using (Nat.mul_le_mul_right (base (w i) L) hp) /-- Every value, including at the finitely many small inputs, is an actual inert prime. -/ def primeFamily {I : Type*} [Fintype I] (w : I → ℝ) (L : ℕ) (i : I) : ℕ := Classical.choose (prime_interval (endpoint w L i) (endpoint_large w L i)) lemma primeFamily_spec {I : Type*} [Fintype I] (w : I → ℝ) (L : ℕ) (i : I) : (primeFamily w L i).Prime ∧ primeFamily w L i % 4 = 3 ∧ endpoint w L i ≤ primeFamily w L i ∧ primeFamily w L i < 2 * endpoint w L i := Classical.choose_spec (prime_interval (endpoint w L i) (endpoint_large w L i)) lemma primeFamily_prime {I : Type*} [Fintype I] (w : I → ℝ) (L : ℕ) (i : I) : (primeFamily w L i).Prime := (primeFamily_spec w L i).1 lemma primeFamily_mod_four {I : Type*} [Fintype I] (w : I → ℝ) (L : ℕ) (i : I) : primeFamily w L i % 4 = 3 := (primeFamily_spec w L i).2.1 private lemma eventually_base_bounds {w : ℝ} (hw : 0 < w) : ∀ᶠ L : ℕ in atTop, (Real.log L) ^ w / 2 ≤ (base w L : ℝ) ∧ (base w L : ℝ) ≤ (Real.log L) ^ w := by have ht := (tendsto_rpow_atTop hw).comp tendsto_log_nat filter_upwards [ht.eventually (eventually_ge_atTop (max (primeThreshold : ℝ) 2))] with L hL have hN : (primeThreshold : ℝ) ≤ (Real.log L) ^ w := (le_max_left _ _).trans hL have htwo : (2 : ℝ) ≤ (Real.log L) ^ w := (le_max_right _ _).trans hL have hfloor : primeThreshold ≤ ⌊(Real.log L) ^ w⌋₊ := Nat.le_floor hN rw [base, max_eq_right hfloor] constructor · have := Nat.lt_floor_add_one ((Real.log L) ^ w) linarith · exact Nat.floor_le (by linarith) private lemma log_power_limit (a w : ℝ) (ha : 0 < a) : Tendsto (fun L : ℕ => Real.log (a * (Real.log L) ^ w) / Real.log (Real.log L)) atTop (𝓝 w) := by have h : Tendsto (fun L : ℕ => Real.log a / Real.log (Real.log L) + w) atTop (𝓝 w) := by simpa using (tendsto_const_nhds.div_atTop tendsto_loglog_nat).add_const w apply h.congr' filter_upwards [tendsto_log_nat.eventually (eventually_gt_atTop (0 : ℝ)), tendsto_loglog_nat.eventually (eventually_gt_atTop (0 : ℝ))] with L hl hll rw [Real.log_mul ha.ne' (Real.rpow_pos_of_pos hl w).ne', Real.log_rpow hl] field_simp <;> ring lemma tendsto_primeFamily_log {I : Type*} [Fintype I] (w : I → ℝ) (hw : ∀ i, 0 < w i) (i : I) : Tendsto (fun L : ℕ => Real.log (primeFamily w L i) / Real.log (Real.log L)) atTop (𝓝 (w i)) := by have hb : ∀ᶠ L : ℕ in atTop, ((2 : ℝ) ^ rank i / 2) * (Real.log L) ^ w i ≤ (primeFamily w L i : ℝ) ∧ (primeFamily w L i : ℝ) ≤ ((2 : ℝ) * 2 ^ rank i) * (Real.log L) ^ w i := by filter_upwards [eventually_base_bounds (hw i)] with L hL have hp := primeFamily_spec w L i dsimp [endpoint] at hp have hlo : (2 : ℝ) ^ rank i * (base (w i) L : ℝ) ≤ primeFamily w L i := by exact_mod_cast hp.2.2.1 have hhi : (primeFamily w L i : ℝ) < 2 * ((2 : ℝ) ^ rank i * (base (w i) L : ℝ)) := by exact_mod_cast hp.2.2.2 constructor · have := mul_le_mul_of_nonneg_left hL.1 (show 0 ≤ (2 : ℝ) ^ rank i by positivity) nlinarith · have := mul_le_mul_of_nonneg_left hL.2 (show 0 ≤ (2 : ℝ) ^ rank i by positivity) nlinarith apply tendsto_of_tendsto_of_tendsto_of_le_of_le' (log_power_limit ((2 : ℝ) ^ rank i / 2) (w i) (by positivity)) (log_power_limit ((2 : ℝ) * 2 ^ rank i) (w i) (by positivity)) · filter_upwards [hb, tendsto_log_nat.eventually (eventually_gt_atTop (0 : ℝ)), tendsto_loglog_nat.eventually (eventually_gt_atTop (0 : ℝ))] with L hL hl hll exact div_le_div_of_nonneg_right (Real.log_le_log (by positivity) hL.1) hll.le · filter_upwards [hb, tendsto_loglog_nat.eventually (eventually_gt_atTop (0 : ℝ))] with L hL hll exact div_le_div_of_nonneg_right (Real.log_le_log (by exact_mod_cast (primeFamily_prime w L i).pos) hL.2) hll.le private lemma primeFamily_lt_of_equal_weight {I : Type*} [Fintype I] (w : I → ℝ) (L : ℕ) {i j : I} (hw : w i = w j) (hr : rank i < rank j) : primeFamily w L i < primeFamily w L j := by have hp : (2 : ℕ) ^ (rank i + 1) ≤ 2 ^ rank j := pow_le_pow_right₀ (by omega) (by omega) have he : 2 * endpoint w L i ≤ endpoint w L j := by simpa [endpoint, hw, pow_succ, Nat.mul_assoc, Nat.mul_left_comm, Nat.mul_comm] using Nat.mul_le_mul_right (base (w j) L) hp exact (primeFamily_spec w L i).2.2.2.trans_le (he.trans (primeFamily_spec w L j).2.2.1) lemma eventually_primeFamily_injective {I : Type*} [Fintype I] (w : I → ℝ) (hw : ∀ i, 0 < w i) : ∀ᶠ L : ℕ in atTop, Function.Injective (primeFamily w L) := by have hpair : ∀ i j : I, ∀ᶠ L : ℕ in atTop, primeFamily w L i = primeFamily w L j → i = j := by intro i j by_cases hij : i = j · exact Eventually.of_forall fun _ _ => hij by_cases hw' : w i = w j · have hr : rank i ≠ rank j := fun h => hij (rank_injective h) rcases lt_or_gt_of_ne hr with hr | hr · exact Eventually.of_forall fun L h => False.elim ((primeFamily_lt_of_equal_weight w L hw' hr).ne h) · exact Eventually.of_forall fun L h => False.elim ((primeFamily_lt_of_equal_weight w L hw'.symm hr).ne h.symm) · have h := ((tendsto_primeFamily_log w hw i).sub (tendsto_primeFamily_log w hw j)).eventually_ne (sub_ne_zero.mpr hw') filter_upwards [h] with L hL heq exact False.elim (hL (by rw [heq, sub_self])) simpa only [Function.Injective, eventually_all] using hpair /-- A fixed subset product, retaining its indexing even before eventual distinctness. -/ def subsetModulus {I : Type*} [Fintype I] (w : I → ℝ) (s : Finset I) (L : ℕ) : ℕ := ∏ i ∈ s, primeFamily w L i lemma subsetModulus_pos {I : Type*} [Fintype I] (w : I → ℝ) (s : Finset I) (L : ℕ) : 0 < subsetModulus w s L := Finset.prod_pos fun i _ => (primeFamily_prime w L i).pos lemma tendsto_subsetModulus_log {I : Type*} [Fintype I] (w : I → ℝ) (hw : ∀ i, 0 < w i) (s : Finset I) : Tendsto (fun L : ℕ => Real.log (subsetModulus w s L) / Real.log (Real.log L)) atTop (𝓝 (∑ i ∈ s, w i)) := by have h := tendsto_finset_sum s (fun i _ => tendsto_primeFamily_log w hw i) convert h using 1 ext L rw [subsetModulus, Nat.cast_prod, Real.log_prod, Finset.sum_div] intro i _ exact_mod_cast (primeFamily_prime w L i).ne_zero /-- Exponent convergence implies both power windows, including when the exponent is zero. -/ lemma eventually_power_window {f : ℕ → ℝ} {a : ℝ} (hf : ∀ᶠ L : ℕ in atTop, 0 < f L) (h : Tendsto (fun L : ℕ => Real.log (f L) / Real.log (Real.log L)) atTop (𝓝 a)) {ε : ℝ} (hε : 0 < ε) : ∀ᶠ L : ℕ in atTop, (Real.log L) ^ (a - ε) ≤ f L ∧ f L ≤ (Real.log L) ^ (a + ε) := by filter_upwards [hf, h.eventually (lt_mem_nhds (show a - ε < a by linarith)), h.eventually (gt_mem_nhds (show a < a + ε by linarith)), tendsto_log_nat.eventually (eventually_gt_atTop (0 : ℝ)), tendsto_loglog_nat.eventually (eventually_gt_atTop (0 : ℝ))] with L hf hl hu hx hxx constructor · exact (Real.rpow_le_iff_le_log hx hf).2 ((lt_div_iff₀ hxx).1 hl).le · exact (Real.le_rpow_iff_log_le hf hx).2 ((div_lt_iff₀ hxx).1 hu).le lemma eventually_subsetModulus_window {I : Type*} [Fintype I] (w : I → ℝ) (hw : ∀ i, 0 < w i) (s : Finset I) {ε : ℝ} (hε : 0 < ε) : ∀ᶠ L : ℕ in atTop, (Real.log L) ^ ((∑ i ∈ s, w i) - ε) ≤ (subsetModulus w s L : ℝ) ∧ (subsetModulus w s L : ℝ) ≤ (Real.log L) ^ ((∑ i ∈ s, w i) + ε) := eventually_power_window (Eventually.of_forall fun L => by exact_mod_cast subsetModulus_pos w s L) (tendsto_subsetModulus_log w hw s) hε /-- The radius used to place a full modulus-scaled lattice box in a disk. -/ def radius {I : Type*} [Fintype I] (w : I → ℝ) (s : Finset I) (C : ℝ) (L : ℕ) : ℝ := C * subsetModulus w s L * L lemma tendsto_radius {I : Type*} [Fintype I] (w : I → ℝ) (s : Finset I) {C : ℝ} (hC : 0 < C) : Tendsto (radius w s C) atTop atTop := by apply tendsto_atTop_mono _ (Tendsto.const_mul_atTop hC (tendsto_natCast_atTop_atTop : Tendsto (fun L : ℕ => (L : ℝ)) atTop atTop)) intro L have hq : (1 : ℝ) ≤ subsetModulus w s L := by exact_mod_cast (Nat.succ_le_iff.mpr (subsetModulus_pos w s L)) dsimp [radius] exact mul_le_mul_of_nonneg_right (show C ≤ C * (subsetModulus w s L : ℝ) by nlinarith) (Nat.cast_nonneg L) lemma tendsto_radius_log {I : Type*} [Fintype I] (w : I → ℝ) (hw : ∀ i, 0 < w i) (s : Finset I) {C : ℝ} (hC : 0 < C) : Tendsto (fun L : ℕ => Real.log (radius w s C L) / Real.log L) atTop (𝓝 1) := by have hsmall : Tendsto (fun L : ℕ => Real.log (Real.log L) / Real.log L) atTop (𝓝 0) := Real.isLittleO_log_id_atTop.tendsto_div_nhds_zero.comp tendsto_log_nat have hq : Tendsto (fun L : ℕ => Real.log (subsetModulus w s L) / Real.log L) atTop (𝓝 0) := by have h := (tendsto_subsetModulus_log w hw s).mul hsmall simp only [mul_zero] at h apply h.congr' filter_upwards [tendsto_loglog_nat.eventually (eventually_gt_atTop (0 : ℝ))] with L hL exact div_mul_div_cancel₀ hL.ne' have h := ((tendsto_const_nhds.div_atTop tendsto_log_nat (a := Real.log C)).add hq).add_const 1 simp only [zero_add] at h apply h.congr' filter_upwards [eventually_gt_atTop (0 : ℕ), tendsto_log_nat.eventually (eventually_gt_atTop (0 : ℝ))] with L hL hl have hq0 : (subsetModulus w s L : ℝ) ≠ 0 := by exact_mod_cast (subsetModulus_pos w s L).ne' have hL0 : (L : ℝ) ≠ 0 := by exact_mod_cast hL.ne' rw [radius, Real.log_mul (mul_ne_zero hC.ne' hq0) hL0, Real.log_mul hC.ne' hq0] field_simp <;> ring private lemma tendsto_log_ratio {f g : ℕ → ℝ} (hf : Tendsto f atTop atTop) (hg : Tendsto g atTop atTop) (h : Tendsto (fun L => f L / g L) atTop (𝓝 1)) : Tendsto (fun L => Real.log (f L) / Real.log (g L)) atTop (𝓝 1) := by have hl := h.log one_ne_zero simp only [Real.log_one] at hl have hh := (hl.div_atTop (Real.tendsto_log_atTop.comp hg)).add_const 1 simp only [Function.comp_def, zero_add] at hh apply hh.congr' filter_upwards [hf.eventually (eventually_gt_atTop (0 : ℝ)), hg.eventually (eventually_gt_atTop (1 : ℝ))] with L hfL hgL rw [Real.log_div hfL.ne' (zero_lt_one.trans hgL).ne'] have := (Real.log_pos hgL).ne' field_simp <;> ring lemma tendsto_radius_loglog {I : Type*} [Fintype I] (w : I → ℝ) (hw : ∀ i, 0 < w i) (s : Finset I) {C : ℝ} (hC : 0 < C) : Tendsto (fun L : ℕ => Real.log (Real.log (radius w s C L)) / Real.log (Real.log L)) atTop (𝓝 1) := tendsto_log_ratio (Real.tendsto_log_atTop.comp (tendsto_radius w s hC)) tendsto_log_nat (tendsto_radius_log w hw s hC) lemma tendsto_subsetModulus_log_radius {I : Type*} [Fintype I] (w : I → ℝ) (hw : ∀ i, 0 < w i) (s : Finset I) {C : ℝ} (hC : 0 < C) : Tendsto (fun L : ℕ => Real.log (subsetModulus w s L) / Real.log (Real.log (radius w s C L))) atTop (𝓝 (∑ i ∈ s, w i)) := by have h := (tendsto_subsetModulus_log w hw s).div (tendsto_radius_loglog w hw s hC) one_ne_zero simp only [div_one] at h apply h.congr' filter_upwards [tendsto_loglog_nat.eventually (eventually_gt_atTop (0 : ℝ))] with L hL exact div_div_div_cancel_right₀ hL.ne' _ _ lemma eventually_subsetModulus_radius_window {I : Type*} [Fintype I] (w : I → ℝ) (hw : ∀ i, 0 < w i) (s : Finset I) {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε) : ∀ᶠ L : ℕ in atTop, (Real.log (radius w s C L)) ^ ((∑ i ∈ s, w i) - ε) ≤ (subsetModulus w s L : ℝ) ∧ (subsetModulus w s L : ℝ) ≤ (Real.log (radius w s C L)) ^ ((∑ i ∈ s, w i) + ε) := by have h := tendsto_subsetModulus_log_radius w hw s hC have hl := Real.tendsto_log_atTop.comp (tendsto_radius w s hC) have hll := Real.tendsto_log_atTop.comp hl filter_upwards [ h.eventually (lt_mem_nhds (show (∑ i ∈ s, w i) - ε < ∑ i ∈ s, w i by linarith)), h.eventually (gt_mem_nhds (show (∑ i ∈ s, w i) < (∑ i ∈ s, w i) + ε by linarith)), hl.eventually (eventually_gt_atTop (0 : ℝ)), hll.eventually (eventually_gt_atTop (0 : ℝ))] with L hlo hhi hx hxx have hq : (0 : ℝ) < subsetModulus w s L := by exact_mod_cast subsetModulus_pos w s L exact ⟨(Real.rpow_le_iff_le_log hx hq).2 ((lt_div_iff₀ hxx).1 hlo).le, (Real.le_rpow_iff_log_le hq hx).2 ((div_lt_iff₀ hxx).1 hhi).le⟩ /-- The finite-type form needs no preselected enumeration and no distinctness of weights. -/ theorem exists_prime_family {I : Type*} [Finite I] (w : I → ℝ) (hw : ∀ i, 0 < w i) : ∃ P : ℕ → I → ℕ, (∀ L i, (P L i).Prime ∧ P L i % 4 = 3) ∧ (∀ᶠ L : ℕ in atTop, Function.Injective (P L)) ∧ ∀ i, Tendsto (fun L : ℕ => Real.log (P L i) / Real.log (Real.log L)) atTop (𝓝 (w i)) := by letI := Fintype.ofFinite I exact ⟨primeFamily w, fun L i => ⟨primeFamily_prime w L i, primeFamily_mod_four w L i⟩, eventually_primeFamily_injective w hw, tendsto_primeFamily_log w hw⟩ end DistanceCounts.PrimeScaleFamilies end end BodyFile048 -- Source: DistanceCounts/GaussianLogWeight.lean section BodyFile049 /-! Reciprocal logarithmic weights on the actual nonzero Gaussian lattice. The finite dyadic cover includes the final shell and the norm-one units. -/ noncomputable section namespace DistanceCounts.GaussianLogWeight open Finset GaussianMass open scoped Classical /-- The summand, with the squared outer radius as parameter. -/ def weight (X : ℝ) (z : GaussianInt) : ℝ := 1 / ((z.norm.natAbs : ℝ) * Real.log (X / z.norm.natAbs)) lemma norm_one_le {z : GaussianInt} (hz : z ≠ 0) : (1 : ℝ) ≤ z.norm.natAbs := by have h : 0 < z.norm.natAbs := Int.natAbs_pos.mpr (GaussianInt.norm_eq_zero.not.mpr hz) exact_mod_cast Nat.succ_le_of_lt h /-- Removing the origin gives a population bound valid even below norm one. -/ lemma representatives_card_le {D : ℝ} (hD : 0 ≤ D) : ((representatives D).card : ℝ) ≤ 9 * Real.pi * D := by have h := GaussianDivisibility.divisorDisk_erase_zero_card_upper (1 : GaussianInt) one_ne_zero (Real.sqrt_nonneg D) simpa [GaussianDivisibility.divisorDisk, GaussianDivisibility.normMass, representatives, Real.sq_sqrt hD] using h lemma denominator_pos {X : ℝ} (hX : 0 < X) {z : GaussianInt} (hz : z ∈ representatives (X / 2)) : 0 < (z.norm.natAbs : ℝ) * Real.log (X / z.norm.natAbs) := by obtain ⟨hz0, hzX⟩ := (mem_representatives (by positivity) z).mp hz have hn : (0 : ℝ) < z.norm.natAbs := lt_of_lt_of_le zero_lt_one (norm_one_le hz0) apply mul_pos hn (Real.log_pos _) apply (lt_div_iff₀ hn).mpr linarith lemma weight_nonneg {X : ℝ} (hX : 0 < X) {z : GaussianInt} (hz : z ∈ representatives (X / 2)) : 0 ≤ weight X z := (one_div_pos.mpr (denominator_pos hX hz)).le /-- Shell `k` has norms in `(X/2^(k+1), X/2^k]`. Restricting to `representatives (X/2)` makes positivity uniform in every finite sum. -/ def shell (X : ℝ) (k : ℕ) : Finset GaussianInt := (representatives (X / 2)).filter (fun z => X / (2 : ℝ) ^ (k + 1) < z.norm.natAbs ∧ (z.norm.natAbs : ℝ) ≤ X / (2 : ℝ) ^ k) /-- Genuine finite shell coverage: the norm lower bound one supplies the upper index, so there is no discarded tail or exceptional unit contribution. -/ lemma shell_cover {X : ℝ} (hX : 0 < X) {z : GaussianInt} (hz : z ∈ representatives (X / 2)) : ∃ k ∈ Icc 1 ⌊Real.log X / Real.log 2⌋₊, z ∈ shell X k := by obtain ⟨hz0, hzX⟩ := (mem_representatives (by positivity) z).mp hz have hn1 := norm_one_le hz0 have hn : (0 : ℝ) < z.norm.natAbs := by linarith have hratio : (2 : ℝ) ≤ X / z.norm.natAbs := by apply (le_div_iff₀ hn).mpr linarith obtain ⟨k, hklo, hkhi⟩ := exists_nat_pow_near (show (1 : ℝ) ≤ X / z.norm.natAbs by linarith) (show (1 : ℝ) < 2 by norm_num) have hk1 : 1 ≤ k := by by_contra h have hk0 : k = 0 := by omega simp only [hk0, zero_add, pow_one] at hkhi linarith have hp : (0 : ℝ) < 2 ^ k := by positivity have hp' : (0 : ℝ) < 2 ^ (k + 1) := by positivity have hrX : X / z.norm.natAbs ≤ X := by apply (div_le_iff₀ hn).mpr nlinarith have hlog := Real.log_le_log hp (hklo.trans hrX) rw [Real.log_pow] at hlog have hkN : k ≤ ⌊Real.log X / Real.log 2⌋₊ := Nat.le_floor ((le_div_iff₀ (Real.log_pos (by norm_num : (1 : ℝ) < 2))).mpr hlog) refine ⟨k, mem_Icc.mpr ⟨hk1, hkN⟩, mem_filter.mpr ⟨hz, ?_, ?_⟩⟩ · apply (div_lt_iff₀ hp').mpr have ht := (div_lt_iff₀ hn).mp hkhi nlinarith · apply (le_div_iff₀ hp).mpr have ht := (le_div_iff₀ hn).mp hklo nlinarith /-- Every nonempty dyadic shell costs at most a constant times `1/k`. The lattice bound remains valid if its upper radius falls below norm one. -/ lemma shell_sum_le {X : ℝ} (hX : 0 < X) {k : ℕ} (hk : 1 ≤ k) : (∑ z ∈ shell X k, weight X z) ≤ (18 * Real.pi / Real.log 2) / k := by let D : ℝ := X / (2 : ℝ) ^ k let L : ℝ := (k : ℝ) * Real.log 2 have hD : 0 < D := by dsimp [D]; positivity have hk0 : (0 : ℝ) < k := by exact_mod_cast (by omega : 0 < k) have hL : 0 < L := mul_pos hk0 (Real.log_pos (by norm_num)) have hterm (z : GaussianInt) (hz : z ∈ shell X k) : weight X z ≤ 2 / (D * L) := by obtain ⟨hzA, hzlo, hzhi⟩ := mem_filter.mp hz have hn : (0 : ℝ) < z.norm.natAbs := by have hz0 := ((mem_representatives (by positivity) z).mp hzA).1 linarith [norm_one_le hz0] have hlo : D / 2 ≤ (z.norm.natAbs : ℝ) := by have he : X / (2 : ℝ) ^ (k + 1) = D / 2 := by dsimp [D] rw [pow_succ, div_mul_eq_div_div] rw [he] at hzlo exact hzlo.le have hratio : (2 : ℝ) ^ k ≤ X / z.norm.natAbs := by apply (le_div_iff₀ hn).mpr have ht := (le_div_iff₀ (by positivity : (0 : ℝ) < 2 ^ k)).mp hzhi nlinarith have hlog : L ≤ Real.log (X / z.norm.natAbs) := by have ht := Real.log_le_log (by positivity : (0 : ℝ) < 2 ^ k) hratio simpa only [Real.log_pow] using ht have hden : D * L / 2 ≤ (z.norm.natAbs : ℝ) * Real.log (X / z.norm.natAbs) := by calc D * L / 2 = (D / 2) * L := by ring _ ≤ (z.norm.natAbs : ℝ) * Real.log (X / z.norm.natAbs) := mul_le_mul hlo hlog hL.le (le_of_lt hn) calc weight X z ≤ 1 / (D * L / 2) := one_div_le_one_div_of_le (by positivity) hden _ = 2 / (D * L) := by field_simp have hsub : shell X k ⊆ representatives D := by intro z hz obtain ⟨hzA, _, hzhi⟩ := mem_filter.mp hz exact (mem_representatives hD.le z).mpr ⟨((mem_representatives (by positivity) z).mp hzA).1, hzhi⟩ have hc : ((shell X k).card : ℝ) ≤ 9 * Real.pi * D := by calc _ ≤ ((representatives D).card : ℝ) := by exact_mod_cast card_le_card hsub _ ≤ _ := representatives_card_le hD.le calc (∑ z ∈ shell X k, weight X z) ≤ ∑ _z ∈ shell X k, 2 / (D * L) := sum_le_sum hterm _ = ((shell X k).card : ℝ) * (2 / (D * L)) := by simp _ ≤ (9 * Real.pi * D) * (2 / (D * L)) := mul_le_mul_of_nonneg_right hc (by positivity) _ = (18 * Real.pi / Real.log 2) / k := by dsimp [L] field_simp [ne_of_gt hD, ne_of_gt hk0, ne_of_gt (Real.log_pos (by norm_num : (1 : ℝ) < 2))] <;> ring /-- The lattice estimate at squared radius `X`, before rescaling its logarithms. -/ theorem sum_le_log_log_quotient {X : ℝ} (hX : 2 ≤ X) : (∑ z ∈ representatives (X / 2), weight X z) ≤ (18 * Real.pi / Real.log 2) * (1 + Real.log (Real.log X / Real.log 2)) := by have hX0 : 0 < X := by linarith let N := ⌊Real.log X / Real.log 2⌋₊ have hcover : (∑ z ∈ representatives (X / 2), weight X z) ≤ ∑ k ∈ Icc 1 N, ∑ z ∈ shell X k, weight X z := by simp only [shell, sum_filter] rw [sum_comm] apply sum_le_sum intro z hz obtain ⟨k, hk, hzk⟩ := shell_cover hX0 hz have hp := (mem_filter.mp hzk).2 calc weight X z = (if X / (2 : ℝ) ^ (k + 1) < z.norm.natAbs ∧ (z.norm.natAbs : ℝ) ≤ X / (2 : ℝ) ^ k then weight X z else 0) := by rw [if_pos hp] _ ≤ _ := single_le_sum (s := Icc 1 N) (a := k) (f := fun i : ℕ => if X / (2 : ℝ) ^ (i + 1) < z.norm.natAbs ∧ (z.norm.natAbs : ℝ) ≤ X / (2 : ℝ) ^ i then weight X z else 0) (fun i _ => by split_ifs <;> first | exact weight_nonneg hX0 hz | exact le_rfl) hk have hL : 1 ≤ Real.log X / Real.log 2 := by apply (le_div_iff₀ (Real.log_pos (by norm_num : (1 : ℝ) < 2))).mpr simpa using Real.log_le_log (by norm_num : (0 : ℝ) < 2) hX have hhar : (∑ k ∈ Icc 1 N, (18 * Real.pi / Real.log 2) / k) = (18 * Real.pi / Real.log 2) * (harmonic N : ℝ) := by simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast, mul_sum, div_eq_mul_inv] calc _ ≤ ∑ k ∈ Icc 1 N, (18 * Real.pi / Real.log 2) / k := hcover.trans (sum_le_sum fun k hk => shell_sum_le hX0 (mem_Icc.mp hk).1) _ = _ := hhar _ ≤ _ := mul_le_mul_of_nonneg_left (harmonic_floor_le_one_add_log _ hL) (by positivity) /-- An absolute constant for the actual-vector reciprocal logarithmic sum. -/ theorem reciprocal_log_sum_bound : ∃ C : ℝ, 0 < C ∧ ∀ R : ℝ, Real.exp 1 ≤ R → (∑ z ∈ representatives (R ^ 2 / 2), 1 / ((z.norm.natAbs : ℝ) * Real.log (R ^ 2 / z.norm.natAbs))) ≤ C * (1 + Real.log (Real.log R)) := by let K : ℝ := 18 * Real.pi / Real.log 2 let B : ℝ := 2 + |Real.log (2 / Real.log 2)| have hl2 : 0 < Real.log (2 : ℝ) := Real.log_pos (by norm_num) have hK : 0 < K := by dsimp [K]; positivity have hB : 0 < B := by dsimp [B]; positivity refine ⟨K * B, mul_pos hK hB, ?_⟩ intro R hR have hR2 : 2 ≤ R := by linarith [Real.add_one_le_exp (1 : ℝ)] have hR0 : 0 < R := by linarith have hlogR : 1 ≤ Real.log R := by have h := Real.log_le_log (Real.exp_pos 1) hR simpa using h have hlogR0 : 0 < Real.log R := by linarith have hll : 0 ≤ Real.log (Real.log R) := Real.log_nonneg hlogR have hX : 2 ≤ R ^ 2 := by nlinarith have he : Real.log (Real.log (R ^ 2) / Real.log 2) = Real.log (2 / Real.log 2) + Real.log (Real.log R) := by rw [Real.log_pow] norm_num only [Nat.cast_ofNat] rw [show 2 * Real.log R / Real.log 2 = (2 / Real.log 2) * Real.log R by ring, Real.log_mul (ne_of_gt (div_pos (by norm_num) hl2)) (ne_of_gt hlogR0)] have habs := le_abs_self (Real.log (2 / Real.log 2)) have hbnd : 1 + Real.log (2 / Real.log 2) + Real.log (Real.log R) ≤ B * (1 + Real.log (Real.log R)) := by dsimp [B] nlinarith [abs_nonneg (Real.log (2 / Real.log 2)), mul_nonneg (abs_nonneg (Real.log (2 / Real.log 2))) hll] have hs := sum_le_log_log_quotient hX rw [he] at hs change (∑ z ∈ representatives (R ^ 2 / 2), weight (R ^ 2) z) ≤ _ calc _ ≤ K * (1 + (Real.log (2 / Real.log 2) + Real.log (Real.log R))) := hs _ ≤ K * (B * (1 + Real.log (Real.log R))) := mul_le_mul_of_nonneg_left (by simpa only [add_assoc] using hbnd) hK.le _ = _ := by ring /-- Positive-sum enlargement, on the actual supports, handles every `Y ≥ 2`. -/ theorem reciprocal_log_sum_bound_uniform : ∃ C : ℝ, 0 < C ∧ ∀ R : ℝ, Real.exp 1 ≤ R → ∀ Y : ℝ, 2 ≤ Y → (∑ z ∈ representatives (R ^ 2 / Y), 1 / ((z.norm.natAbs : ℝ) * Real.log (R ^ 2 / z.norm.natAbs))) ≤ C * (1 + Real.log (Real.log R)) := by obtain ⟨C, hC, hbound⟩ := reciprocal_log_sum_bound refine ⟨C, hC, ?_⟩ intro R hR Y hY have hR0 : 0 < R := lt_of_lt_of_le (Real.exp_pos 1) hR have hY0 : 0 < Y := by linarith have hcut : R ^ 2 / Y ≤ R ^ 2 / 2 := div_le_div_of_nonneg_left (sq_nonneg R) (by norm_num) hY have hsub : representatives (R ^ 2 / Y) ⊆ representatives (R ^ 2 / 2) := by intro z hz obtain ⟨hz0, hzn⟩ := (mem_representatives (by positivity) z).mp hz exact (mem_representatives (by positivity) z).mpr ⟨hz0, hzn.trans hcut⟩ apply le_trans (sum_le_sum_of_subset_of_nonneg hsub ?_) (hbound R hR) intro z hz _ exact weight_nonneg (sq_pos_of_pos hR0) hz end DistanceCounts.GaussianLogWeight end end BodyFile049 -- Source: DistanceCounts/HighTransitionRates.lean section BodyFile050 /-! Radius-only decay for the four actual high-transition populations. -/ noncomputable section namespace DistanceCounts.HighTransitionRates open Filter Finset open scoped Topology Classical /-- Half the strict gap above the transition exponent. -/ def epsilon (c : ℝ) : ℝ := (c - Real.log 2) / 2 /-- The manuscript scales, safely below both the modulus and radius exponents. -/ def kappa (c : ℝ) : ℝ := min c 1 / 8 /-- The actual normal-order upper cutoff. -/ def threshold (R c : ℝ) : ℝ := (Real.log R) ^ (Real.log 2 + epsilon c) lemma parameters {c : ℝ} (hc : Real.log 2 < c) : 0 < epsilon c ∧ 0 < kappa c ∧ 0 < 2 * kappa c ∧ 2 * kappa c < min c 1 := by have hc0 : 0 < c := (Real.log_pos (by norm_num : (1 : ℝ) < 2)).trans hc have hm : 0 < min c 1 := lt_min hc0 zero_lt_one dsimp [epsilon, kappa] constructor · linarith constructor · positivity constructor <;> linarith /-- The precise exponent conversion needed by the proved prime bound. -/ lemma log_manuscriptY_rpow {R κ : ℝ} (hR : 1 < R) (hκ : 0 < κ) (A : ℝ) : (Real.log (GaussianSmoothPart.manuscriptY R κ)) ^ (A / κ) = (Real.log R) ^ A := by rw [GaussianSmoothPart.manuscriptY, Real.log_exp, ← Real.rpow_mul (Real.log_pos hR).le] congr 1 field_simp [ne_of_gt hκ] <;> ring lemma tendsto_manuscriptY {κ : ℝ} (hκ : 0 < κ) : Tendsto (fun R => GaussianSmoothPart.manuscriptY R κ) atTop atTop := Real.tendsto_exp_atTop.comp ((tendsto_rpow_atTop hκ).comp Real.tendsto_log_atTop) private lemma tendsto_power_ratio {a b : ℝ} (hab : a < b) : Tendsto (fun x : ℝ => x ^ a / x ^ b) atTop (𝓝 0) := by have h := tendsto_rpow_neg_atTop (sub_pos.mpr hab) apply h.congr' filter_upwards [eventually_gt_atTop (0 : ℝ)] with x hx rw [← Real.rpow_sub hx] congr 1 ring private lemma tendsto_power_ratio_log {a b : ℝ} (hab : a < b) : Tendsto (fun x : ℝ => x ^ a / x ^ b * (1 + Real.log x)) atTop (𝓝 0) := by have hi : Tendsto (fun x : ℝ => 1 / x ^ (b - a)) atTop (𝓝 0) := by simpa only [Real.rpow_zero] using (tendsto_power_ratio (a := 0) (b := b - a) (sub_pos.mpr hab)) have hl := (isLittleO_log_rpow_rpow_atTop 1 (sub_pos.mpr hab)).tendsto_div_nhds_zero have h : Tendsto (fun x : ℝ => (1 + Real.log x) / x ^ (b - a)) atTop (𝓝 0) := by simpa only [Real.rpow_one, add_div, zero_add] using hi.add hl apply h.congr' filter_upwards [eventually_gt_atTop (0 : ℝ)] with x hx rw [← Real.rpow_sub hx, show a - b = -(b - a) by ring, Real.rpow_neg hx.le] ring /-- The small-flip majorant retains exactly the manuscript's `log S`. -/ def smallRate (c R : ℝ) : ℝ := (2304 * Real.pi) * (1 + Real.log (GaussianSmoothPart.manuscriptS R (kappa c))) / (Real.log R) ^ c /-- The large-flip majorant uses the genuine reciprocal-log sum, not a harmonic substitute. -/ def largeRate (c C R : ℝ) : ℝ := C * threshold R c / (Real.log R) ^ c * (1 + Real.log (Real.log R)) lemma tendsto_smallRate {c : ℝ} (hc : Real.log 2 < c) : Tendsto (smallRate c) atTop (𝓝 0) := by unfold smallRate have hp := parameters hc have hc0 : 0 < c := (Real.log_pos (by norm_num : (1 : ℝ) < 2)).trans hc have hk : 2 * kappa c < c := hp.2.2.2.trans_le (min_le_left _ _) have h0 := (tendsto_power_ratio (a := 0) hc0).comp Real.tendsto_log_atTop have hs := (tendsto_power_ratio hk).comp Real.tendsto_log_atTop simpa only [Function.comp_def, Real.rpow_zero, smallRate, GaussianSmoothPart.manuscriptS, Real.log_exp, add_div, mul_add, mul_div_assoc, zero_add, mul_zero] using (h0.add hs).const_mul (2304 * Real.pi) lemma tendsto_largeRate {c : ℝ} (hc : Real.log 2 < c) (C : ℝ) : Tendsto (largeRate c C) atTop (𝓝 0) := by unfold largeRate have hexp : Real.log 2 + epsilon c < c := by dsimp [epsilon]; linarith have h := (tendsto_power_ratio_log hexp).comp Real.tendsto_log_atTop simpa only [Function.comp_def, largeRate, threshold, mul_div_assoc, mul_assoc, mul_zero] using h.const_mul C /-- An explicit error depending only on the radius and fixed constants. Its first two terms are the actual exceptional densities, not assumed rates. -/ def errorBound (c C R : ℝ) : ℝ := ((GaussianNormalOrder.normalBad R (epsilon c)).card : ℝ) / R ^ 2 + ((GaussianSmoothPart.exceptional R (GaussianSmoothPart.manuscriptY R (kappa c)) (GaussianSmoothPart.manuscriptS R (kappa c))).card : ℝ) / R ^ 2 + smallRate c R + largeRate c C R lemma tendsto_errorBound {c : ℝ} (hc : Real.log 2 < c) (C : ℝ) : Tendsto (errorBound c C) atTop (𝓝 0) := by unfold errorBound have hp := parameters hc simpa only [errorBound, zero_add] using (((GaussianNormalOrder.tendsto_normalBad_card hp.1).add (GaussianSmoothPart.tendsto_exceptional_card hp.2.1)).add (tendsto_smallRate hc)).add (tendsto_largeRate hc C) /-- The complete actual upper bound, with no squarefreeness exclusion. The small-flip API takes its cutoff before its radius. -/ def upperDensity (q : ℕ) (R c : ℝ) : ℝ := (((GaussianNormalOrder.normalBad R (epsilon c)).card : ℝ) + ((GaussianSmoothPart.exceptional R (GaussianSmoothPart.manuscriptY R (kappa c)) (GaussianSmoothPart.manuscriptS R (kappa c))).card : ℝ) + ((SmallFlipLattice.smallFlipDivisibleVectors q (GaussianSmoothPart.manuscriptS R (kappa c)) R).card : ℝ) + ((LargeFlipCount.largeFlipVectors q R (GaussianSmoothPart.manuscriptY R (kappa c)) (threshold R c)).card : ℝ)) / R ^ 2 /-- Uniformity is simultaneous over all real radii and all products of at most four inert primes in the stated window. The prime bound and reciprocal-log estimate are proved inputs instantiated here, never hypotheses of this result. -/ theorem exists_uniform_error {c A : ℝ} (hc : Real.log 2 < c) (hA : 0 < A) : ∃ C : ℝ, 0 < C ∧ Tendsto (errorBound c C) atTop (𝓝 0) ∧ ∀ᶠ R : ℝ in atTop, ∀ q : ℕ, ∀ P : Finset ℕ, q = ∏ p ∈ P, p → P.card ≤ 4 → (∀ p ∈ P, p.Prime ∧ p % 4 = 3) → (Real.log R) ^ c ≤ (q : ℝ) → (q : ℝ) ≤ (Real.log R) ^ A → upperDensity q R c ≤ errorBound c C R := by have hp := parameters hc obtain ⟨C₁, Z₀, hC₁, _hZ₀, hfinite⟩ := LargeFlipCount.largeFlipVectors_card_polylog (A / kappa c) (div_pos hA hp.2.1) obtain ⟨C₂, hC₂, hweight⟩ := GaussianLogWeight.reciprocal_log_sum_bound_uniform refine ⟨C₁ * C₂, mul_pos hC₁ hC₂, tendsto_errorBound hc _, ?_⟩ filter_upwards [eventually_gt_atTop (1 : ℝ), eventually_ge_atTop (Real.exp 1), (tendsto_manuscriptY hp.2.1).eventually (eventually_ge_atTop (max Z₀ 2))] with R hR hRexp hY intro q P hqeq hfour hP hqlow hqhigh subst q let q : ℕ := ∏ p ∈ P, p have hq : 0 < q := Finset.prod_pos fun p hp => (hP p hp).1.pos have hq0 : (0 : ℝ) < q := by exact_mod_cast hq have hR0 : 0 < R := zero_lt_one.trans hR have hl : 0 < Real.log R := Real.log_pos hR have hpow : 0 < (Real.log R) ^ c := Real.rpow_pos_of_pos hl _ have hT : 0 ≤ threshold R c := (Real.rpow_pos_of_pos hl _).le have hS : 1 ≤ GaussianSmoothPart.manuscriptS R (kappa c) := Real.one_le_exp_iff.mpr (Real.rpow_nonneg hl.le _) have hY2 : 2 ≤ GaussianSmoothPart.manuscriptY R (kappa c) := (le_max_right _ _).trans hY have hlog1 : 1 ≤ Real.log R := by simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hRexp have hloglog : 0 ≤ 1 + Real.log (Real.log R) := by have := Real.log_nonneg hlog1 linarith have hqY : (q : ℝ) ≤ (Real.log (GaussianSmoothPart.manuscriptY R (kappa c))) ^ (A / kappa c) := by rw [log_manuscriptY_rpow hR hp.2.1] exact hqhigh have hsmall : ((SmallFlipLattice.smallFlipDivisibleVectors q (GaussianSmoothPart.manuscriptS R (kappa c)) R).card : ℝ) / R ^ 2 ≤ smallRate c R := by have hb := SmallFlipLattice.smallFlipDivisibleVectors_card_upper q (Nat.one_le_iff_ne_zero.mpr (ne_of_gt hq)) hS hR0.le have hn : 0 ≤ (2304 * Real.pi) * (1 + Real.log (GaussianSmoothPart.manuscriptS R (kappa c))) := by have := Real.log_nonneg hS positivity calc _ ≤ ((2304 * Real.pi) * R ^ 2 * (1 + Real.log (GaussianSmoothPart.manuscriptS R (kappa c))) / (q : ℝ)) / R ^ 2 := div_le_div_of_nonneg_right hb (sq_nonneg R) _ = (2304 * Real.pi) * (1 + Real.log (GaussianSmoothPart.manuscriptS R (kappa c))) / (q : ℝ) := by field_simp [ne_of_gt hR0, ne_of_gt hq0] <;> ring _ ≤ smallRate c R := div_le_div_of_nonneg_left hn hpow hqlow have hlarge : ((LargeFlipCount.largeFlipVectors q R (GaussianSmoothPart.manuscriptY R (kappa c)) (threshold R c)).card : ℝ) / R ^ 2 ≤ largeRate c (C₁ * C₂) R := by have hb := hfinite P hfour hP R _ _ hR0.le hY hT hqY have hw := hweight R hRexp (GaussianSmoothPart.manuscriptY R (kappa c)) hY2 have hw' : (∑ u ∈ GaussianMass.representatives (R ^ 2 / GaussianSmoothPart.manuscriptY R (kappa c)), 1 / (GaussianDivisibility.normMass u * Real.log (R ^ 2 / GaussianDivisibility.normMass u))) ≤ C₂ * (1 + Real.log (Real.log R)) := hw have hcoef : 0 ≤ C₁ * (threshold R c / (q : ℝ)) * R ^ 2 := by positivity have hb' := hb.trans (mul_le_mul_of_nonneg_left hw' hcoef) have hn : 0 ≤ (C₁ * C₂) * threshold R c * (1 + Real.log (Real.log R)) := by positivity calc _ ≤ (C₁ * (threshold R c / (q : ℝ)) * R ^ 2 * (C₂ * (1 + Real.log (Real.log R)))) / R ^ 2 := div_le_div_of_nonneg_right hb' (sq_nonneg R) _ = ((C₁ * C₂) * threshold R c * (1 + Real.log (Real.log R))) / (q : ℝ) := by field_simp [ne_of_gt hR0, ne_of_gt hq0] <;> ring _ ≤ ((C₁ * C₂) * threshold R c * (1 + Real.log (Real.log R))) / (Real.log R) ^ c := div_le_div_of_nonneg_left hn hpow hqlow _ = largeRate c (C₁ * C₂) R := by unfold largeRate; ring unfold upperDensity errorBound rw [add_div, add_div, add_div] linarith [hsmall, hlarge] end DistanceCounts.HighTransitionRates end end BodyFile050 -- Source: DistanceCounts/HighTransition.lean section BodyFile051 /-! Uniform high-denominator collision decay for the actual Gaussian populations. -/ noncomputable section namespace DistanceCounts.HighTransition open Filter Finset HighCollisionCover HighTransitionRates open scoped Topology Classical theorem excessive_subset_normalBad (R c : ℝ) : excessiveRepresentations R (threshold R c) ⊆ GaussianNormalOrder.normalBad R (epsilon c) := by intro z hz obtain ⟨hz, he⟩ := mem_filter.mp hz exact mem_filter.mpr ⟨hz, Or.inr he⟩ theorem collision_density_le (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime ∧ p % 4 = 3) {R c : ℝ} (hR : 0 ≤ R) : ((collisionVectors (∏ p ∈ P, p) R).card : ℝ) / R ^ 2 ≤ upperDensity (∏ p ∈ P, p) R c := by let Y := GaussianSmoothPart.manuscriptY R (kappa c) let S := GaussianSmoothPart.manuscriptS R (kappa c) let A := GaussianNormalOrder.normalBad R (epsilon c) let B := GaussianSmoothPart.exceptional R Y S let C := SmallFlipLattice.smallFlipDivisibleVectors (∏ p ∈ P, p) S R let D := LargeFlipCount.largeFlipVectors (∏ p ∈ P, p) R Y (threshold R c) have hY : 0 ≤ Y := by unfold Y GaussianSmoothPart.manuscriptY; positivity have he := excessive_subset_normalBad R c have hcover : collisionVectors (∏ p ∈ P, p) R ⊆ A ∪ B ∪ C ∪ D := by intro z hz have hz' := collisionVectors_subset P hP (S := S) (T := threshold R c) hR hY hz simp only [mem_union] at hz' ⊢ rcases hz' with ((hz' | hz') | hz') | hz' · exact Or.inl (Or.inl (Or.inl (he hz'))) · exact Or.inl (Or.inl (Or.inr hz')) · exact Or.inl (Or.inr hz') · exact Or.inr hz' have hcard := card_le_card hcover have h₁ := card_union_le (A ∪ B ∪ C) D have h₂ := card_union_le (A ∪ B) C have h₃ := card_union_le A B have hn : ((collisionVectors (∏ p ∈ P, p) R).card : ℝ) ≤ (A.card : ℝ) + (B.card : ℝ) + (C.card : ℝ) + (D.card : ℝ) := by exact_mod_cast (show (collisionVectors (∏ p ∈ P, p) R).card ≤ A.card + B.card + C.card + D.card by omega) exact div_le_div_of_nonneg_right hn (sq_nonneg R) /-- This bounds actual collisions, not an assumed high-transition property. -/ theorem exists_uniform_collision_error {c A : ℝ} (hc : Real.log 2 < c) (hA : 0 < A) : ∃ e : ℝ → ℝ, Tendsto e atTop (𝓝 0) ∧ ∀ᶠ R : ℝ in atTop, ∀ P : Finset ℕ, P.card ≤ 4 → (∀ p ∈ P, p.Prime ∧ p % 4 = 3) → (Real.log R) ^ c ≤ ((∏ p ∈ P, p : ℕ) : ℝ) → ((∏ p ∈ P, p : ℕ) : ℝ) ≤ (Real.log R) ^ A → ((collisionVectors (∏ p ∈ P, p) R).card : ℝ) / R ^ 2 ≤ e R := by obtain ⟨C, hC, ht, hu⟩ := HighTransitionRates.exists_uniform_error hc hA refine ⟨errorBound c C, ht, ?_⟩ filter_upwards [hu, eventually_ge_atTop (0 : ℝ)] with R hRu hR intro P hcard hP hlo hhi exact (collision_density_le P hP hR).trans (hRu _ P rfl hcard hP hlo hhi) end DistanceCounts.HighTransition end end BodyFile051 -- Source: DistanceCounts/FiniteCoordinateSelection.lean section BodyFile052 /-! Finite-coordinate avoidance by counting restriction fibers and taking a union bound. The bad events may overlap arbitrarily; no independence hypothesis is used. -/ noncomputable section open scoped BigOperators namespace DistanceCounts.FiniteCoordinateSelection variable {I : Type*} [Fintype I] [DecidableEq I] (Ω : I → Type*) [∀ i, Fintype (Ω i)] /-- Splitting a full assignment into its specified coordinates and all remaining coordinates. This also applies when either coordinate set is empty. -/ def restrictionEquiv (S : Finset I) : (∀ i, Ω i) ≃ (∀ i : S, Ω i) × (∀ i : {i // i ∉ S}, Ω i) := by classical exact Equiv.piEquivPiSubtypeProd (fun i => i ∈ S) Ω /-- The number of local tuples is the product of the coordinate cardinalities. -/ theorem card_localTuple (S : Finset I) : Fintype.card (∀ i : S, Ω i) = ∏ i ∈ S, Fintype.card (Ω i) := by classical rw [Fintype.card_pi] exact Finset.prod_coe_sort S (fun i => Fintype.card (Ω i)) /-- The same complement factor occurs in the total count and in every restriction fiber. -/ theorem card_assignments_eq (S : Finset I) : Fintype.card (∀ i, Ω i) = Fintype.card (∀ i : S, Ω i) * Fintype.card (∀ i : {i // i ∉ S}, Ω i) := by classical simpa only [Fintype.card_prod] using Fintype.card_congr (restrictionEquiv Ω S) /-- Local tuples whose injective encoding is forbidden. -/ def localBad (S : Finset I) {R : Type*} (ψ : (∀ i : S, Ω i) → R) (B : Finset R) : Finset (∀ i : S, Ω i) := by classical exact Finset.univ.filter (fun x => ψ x ∈ B) /-- Full assignments whose restriction has a forbidden encoding. -/ def badAssignments (S : Finset I) {R : Type*} (ψ : (∀ i : S, Ω i) → R) (B : Finset R) : Finset (∀ i, Ω i) := by classical exact Finset.univ.filter (fun ω => ψ (fun i : S => ω i) ∈ B) /-- Injectivity, not any distributional assumption, bounds the local bad count. -/ theorem card_localBad_le (S : Finset I) {R : Type*} (ψ : (∀ i : S, Ω i) → R) (hψ : Function.Injective ψ) (B : Finset R) : (localBad Ω S ψ B).card ≤ B.card := by classical apply Finset.card_le_card_of_injOn ψ · intro x hx exact (Finset.mem_filter.mp hx).2 · intro x _ y _ hxy exact hψ hxy /-- Exact counting of bad full assignments: each bad local tuple has one extension for every tuple on the complementary coordinates. -/ theorem card_badAssignments_eq (S : Finset I) {R : Type*} (ψ : (∀ i : S, Ω i) → R) (B : Finset R) : (badAssignments Ω S ψ B).card = (localBad Ω S ψ B).card * Fintype.card (∀ i : {i // i ∉ S}, Ω i) := by classical let e : {ω : (∀ i, Ω i) // ψ (fun i : S => ω i) ∈ B} ≃ {x : (∀ i : S, Ω i) × (∀ i : {i // i ∉ S}, Ω i) // ψ x.1 ∈ B} := (restrictionEquiv Ω S).subtypeEquiv (fun _ => Iff.rfl) let f : {x : (∀ i : S, Ω i) × (∀ i : {i // i ∉ S}, Ω i) // ψ x.1 ∈ B} ≃ {x : (∀ i : S, Ω i) // ψ x ∈ B} × (∀ i : {i // i ∉ S}, Ω i) := Equiv.prodSubtypeFstEquivSubtypeProd (α := ∀ i : S, Ω i) (β := ∀ i : {i // i ∉ S}, Ω i) (p := fun x => ψ x ∈ B) simpa only [Fintype.card_prod, Fintype.card_subtype, badAssignments, localBad] using Fintype.card_congr (e.trans f) /-- The forbidden-image count times the unrestricted complement count bounds the actual number of bad full assignments. -/ theorem card_badAssignments_le (S : Finset I) {R : Type*} (ψ : (∀ i : S, Ω i) → R) (hψ : Function.Injective ψ) (B : Finset R) : (badAssignments Ω S ψ B).card ≤ B.card * Fintype.card (∀ i : {i // i ∉ S}, Ω i) := by rw [card_badAssignments_eq] exact Nat.mul_le_mul_right _ (card_localBad_le Ω S ψ hψ B) /-- Cancelling the complement factor gives the exact finite-coordinate fraction bound. Nonempty coordinate spaces ensure that neither denominator vanishes. -/ theorem bad_assignment_fraction_le [∀ i, Nonempty (Ω i)] (S : Finset I) {R : Type*} (ψ : (∀ i : S, Ω i) → R) (hψ : Function.Injective ψ) (B : Finset R) : ((badAssignments Ω S ψ B).card : ℝ) / Fintype.card (∀ i, Ω i) ≤ (B.card : ℝ) / (∏ i ∈ S, Fintype.card (Ω i) : ℕ) := by classical have hL : 0 < (Fintype.card (∀ i : S, Ω i) : ℝ) := by exact_mod_cast (Fintype.card_pos : 0 < Fintype.card (∀ i : S, Ω i)) have hC : 0 < (Fintype.card (∀ i : {i // i ∉ S}, Ω i) : ℝ) := by exact_mod_cast (Fintype.card_pos : 0 < Fintype.card (∀ i : {i // i ∉ S}, Ω i)) calc ((badAssignments Ω S ψ B).card : ℝ) / Fintype.card (∀ i, Ω i) = ((badAssignments Ω S ψ B).card : ℝ) / ((Fintype.card (∀ i : S, Ω i) : ℝ) * Fintype.card (∀ i : {i // i ∉ S}, Ω i)) := by rw [card_assignments_eq Ω S, Nat.cast_mul] _ ≤ ((B.card : ℝ) * Fintype.card (∀ i : {i // i ∉ S}, Ω i)) / ((Fintype.card (∀ i : S, Ω i) : ℝ) * Fintype.card (∀ i : {i // i ∉ S}, Ω i)) := by apply div_le_div_of_nonneg_right _ (mul_nonneg hL.le hC.le) exact_mod_cast card_badAssignments_le Ω S ψ hψ B _ = (B.card : ℝ) / Fintype.card (∀ i : S, Ω i) := mul_div_mul_right _ _ (ne_of_gt hC) _ = (B.card : ℝ) / (∏ i ∈ S, Fintype.card (Ω i) : ℕ) := by rw [card_localTuple] variable {E : Type*} [Fintype E] /-- The union of the actual bad events in the full function space. -/ def badUnion (S : E → Finset I) (R : E → Type*) (ψ : ∀ e, (∀ i : S e, Ω i) → R e) (B : ∀ e, Finset (R e)) : Finset (∀ i, Ω i) := by classical exact Finset.univ.biUnion (fun e => badAssignments Ω (S e) (ψ e) (B e)) /-- A quantitative union bound, valid even when different events share all their coordinates or their bad assignments. -/ theorem bad_union_fraction_le [∀ i, Nonempty (Ω i)] (S : E → Finset I) (R : E → Type*) (ψ : ∀ e, (∀ i : S e, Ω i) → R e) (hψ : ∀ e, Function.Injective (ψ e)) (B : ∀ e, Finset (R e)) : ((badUnion Ω S R ψ B).card : ℝ) / Fintype.card (∀ i, Ω i) ≤ ∑ e, ((B e).card : ℝ) / (∏ i ∈ S e, Fintype.card (Ω i) : ℕ) := by classical have htotal : 0 ≤ (Fintype.card (∀ i, Ω i) : ℝ) := Nat.cast_nonneg _ have hcount : (badUnion Ω S R ψ B).card ≤ ∑ e, (badAssignments Ω (S e) (ψ e) (B e)).card := Finset.card_biUnion_le calc ((badUnion Ω S R ψ B).card : ℝ) / Fintype.card (∀ i, Ω i) ≤ ((∑ e, (badAssignments Ω (S e) (ψ e) (B e)).card : ℕ) : ℝ) / Fintype.card (∀ i, Ω i) := by apply div_le_div_of_nonneg_right _ htotal exact_mod_cast hcount _ = ∑ e, ((badAssignments Ω (S e) (ψ e) (B e)).card : ℝ) / Fintype.card (∀ i, Ω i) := by rw [Nat.cast_sum, Finset.sum_div] _ ≤ _ := Finset.sum_le_sum fun e _ => bad_assignment_fraction_le Ω (S e) (ψ e) (hψ e) (B e) /-- Simultaneous avoidance in the genuine finite dependent function space. Only injectivity of the local encodings and the numerical union bound are required; no independence between events or prior good assignment is assumed. Empty event sets and empty coordinate sets are included. -/ theorem exists_avoiding [∀ i, Nonempty (Ω i)] (S : E → Finset I) (R : E → Type*) (ψ : ∀ e, (∀ i : S e, Ω i) → R e) (hψ : ∀ e, Function.Injective (ψ e)) (B : ∀ e, Finset (R e)) (hsmall : (∑ e, ((B e).card : ℝ) / (∏ i ∈ S e, Fintype.card (Ω i) : ℕ) : ℝ) < 1) : ∃ ω : ∀ i, Ω i, ∀ e, ψ e (fun i : S e => ω i) ∉ B e := by classical have htotal : 0 < (Fintype.card (∀ i, Ω i) : ℝ) := by exact_mod_cast (Fintype.card_pos : 0 < Fintype.card (∀ i, Ω i)) have hfrac := (bad_union_fraction_le Ω S R ψ hψ B).trans_lt hsmall have hltReal : ((badUnion Ω S R ψ B).card : ℝ) < (Fintype.card (∀ i, Ω i) : ℝ) := (div_lt_one htotal).mp hfrac have hlt : (badUnion Ω S R ψ B).card < (Finset.univ : Finset (∀ i, Ω i)).card := by exact_mod_cast hltReal obtain ⟨ω, _, hω⟩ := Finset.exists_mem_notMem_of_card_lt_card hlt refine ⟨ω, fun e he => hω ?_⟩ apply Finset.mem_biUnion.mpr refine ⟨e, Finset.mem_univ _, ?_⟩ exact Finset.mem_filter.mpr ⟨Finset.mem_univ _, he⟩ end DistanceCounts.FiniteCoordinateSelection end end BodyFile052 -- Source: DistanceCounts/OffsetSelection.lean section BodyFile053 noncomputable section open Filter Finset open scoped Topology Classical BigOperators namespace DistanceCounts.OffsetSelection open CoarseGrid PairModulus CoarseConditions GaussianResidues abbrev Axis (s : ℕ) := Fin (2 * s) ⊕ Fin (2 * s) abbrev Block (s : ℕ) := Fin (2 * s) × Fin (2 * s) abbrev Event (s : ℕ) := (Block s × Block s) ⊕ Axis s def primes (s L : ℕ) : Axis s → ℕ := PrimeScaleFamilies.primeFamily ThresholdWeights.weight L lemma primes_prime (s L : ℕ) (i : Axis s) : (primes s L i).Prime := PrimeScaleFamilies.primeFamily_prime _ _ _ lemma primes_inert (s L : ℕ) (i : Axis s) : primes s L i % 4 = 3 := PrimeScaleFamilies.primeFamily_mod_four _ _ _ lemma primes_injective {s : ℕ} (hs : 0 < s) : ∀ᶠ L in atTop, Function.Injective (primes s L) := PrimeScaleFamilies.eventually_primeFamily_injective _ (ThresholdWeights.weight_pos (by omega)) lemma primes_tendsto {s : ℕ} (hs : 0 < s) (i : Axis s) : Tendsto (fun L => (primes s L i : ℝ)) atTop atTop := by have hw := ThresholdWeights.weight_pos (show 0 < 2 * s by omega) i have hwin := PrimeScaleFamilies.eventually_power_window (Eventually.of_forall fun L => show (0 : ℝ) < primes s L i by exact_mod_cast (primes_prime s L i).pos) (PrimeScaleFamilies.tendsto_primeFamily_log ThresholdWeights.weight (ThresholdWeights.weight_pos (show 0 < 2 * s by omega)) i) (show 0 < ThresholdWeights.weight i / 2 by positivity) apply tendsto_atTop_mono' _ _ ((tendsto_rpow_atTop (show 0 < ThresholdWeights.weight i - ThresholdWeights.weight i / 2 by linarith)).comp PrimeScaleFamilies.tendsto_log_nat) exact hwin.mono fun _ h => h.1 lemma radius_tendsto (s : ℕ) (b c : Block s) : Tendsto (fun L => pairRadius L (primes s L) b c) atTop atTop := PrimeScaleFamilies.tendsto_radius ThresholdWeights.weight (pairSupport b c) (show (0 : ℝ) < 6 by norm_num) /-- The error is the actual normalized population relevant to this ordered pair. -/ def pairError (s L : ℕ) (b c : Block s) : ℝ := if (c.1.val, c.2.val) ∈ DistanceCounts.highTargets s b.1.val b.2.val then ((HighCollisionCover.collisionVectors (modulus (primes s L) b c) (pairRadius L (primes s L) b c)).card : ℝ) / (pairRadius L (primes s L) b c) ^ 2 else LowPalette.aggregate (modulus (primes s L) b c) (modulus_pos _ (primes_prime s L) b c) (pairRadius L (primes s L) b c) / (pairRadius L (primes s L) b c) ^ 2 lemma pairError_nonneg (s L : ℕ) (b c : Block s) : 0 ≤ pairError s L b c := by unfold pairError LowPalette.aggregate split_ifs <;> positivity lemma pairError_tendsto {s : ℕ} (hs : 0 < s) (b c : Block s) : Tendsto (fun L => pairError s L b c) atTop (𝓝 0) := by let a := ThresholdWeights.pairExponent b c have hw := ThresholdWeights.weight_pos (show 0 < 2 * s by omega) have hr := radius_tendsto s b c have ha : 0 ≤ a := Finset.sum_nonneg fun i _ => (hw i).le by_cases hh : (c.1.val, c.2.val) ∈ DistanceCounts.highTargets s b.1.val b.2.val · have hgap : Real.log 2 < a := (ThresholdWeights.log_two_lt_pairExponent_iff hs b c).mpr hh let δ := (a - Real.log 2) / 2 have hδ : 0 < δ := by dsimp [δ]; linarith have hc : Real.log 2 < a - δ := by dsimp [δ]; linarith obtain ⟨e, he, hu⟩ := HighTransition.exists_uniform_collision_error hc (show 0 < a + δ by linarith) have hwin := PrimeScaleFamilies.eventually_subsetModulus_radius_window ThresholdWeights.weight hw (pairSupport b c) (show (0 : ℝ) < 6 by norm_num) hδ apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds (he.comp hr) (Eventually.of_forall fun L => pairError_nonneg s L b c) filter_upwards [hr.eventually hu, hwin, primes_injective hs] with L hU hW hd have h := hU (primeSet (primes s L) b c) (primeSet_card_le_four _ b c) (fun r hr => by obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp hr exact ⟨primes_prime s L i, primes_inert s L i⟩) have hq := modulus_eq_primeSet_prod (primes s L) hd b c have hlo : (Real.log (pairRadius L (primes s L) b c)) ^ (a - δ) ≤ (modulus (primes s L) b c : ℝ) := hW.1 have hhi : (modulus (primes s L) b c : ℝ) ≤ (Real.log (pairRadius L (primes s L) b c)) ^ (a + δ) := hW.2 rw [hq] at hlo hhi simpa only [Function.comp_def, pairError, if_pos hh, hq] using h hlo hhi · have hgap : a < Real.log 2 := (ThresholdWeights.pairExponent_lt_log_two_iff hs b c).mpr hh let δ := (Real.log 2 - a) / 2 have hδ : 0 < δ := by dsimp [δ]; linarith have hc : a + δ < Real.log 2 := by dsimp [δ]; linarith have hwin := PrimeScaleFamilies.eventually_subsetModulus_radius_window ThresholdWeights.weight hw (pairSupport b c) (show (0 : ℝ) < 6 by norm_num) hδ apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds ((LowPalette.tendsto_error hc).comp hr) (Eventually.of_forall fun L => pairError_nonneg s L b c) filter_upwards [hr.eventually (LowPalette.eventually_uniform_low hc), hwin, primes_injective hs] with L hU hW hd have hq := modulus_eq_primeSet_prod (primes s L) hd b c have hhi : (modulus (primes s L) b c : ℝ) ≤ (Real.log (pairRadius L (primes s L) b c)) ^ (a + δ) := hW.2 rw [hq] at hhi simpa only [Function.comp_def, pairError, if_neg hh, hq] using hU (primeSet (primes s L) b c) (primeSet_prime _ (primes_prime s L) b c) (primeSet_card_le_four _ b c) hhi /-- All ordered block pairs remain in this sum, including self pairs. -/ def totalError (s L : ℕ) : ℝ := ∑ bc : Block s × Block s, max 0 (pairError s L bc.1 bc.2) def tolerance (s L : ℕ) : ℝ := Real.sqrt (totalError s L) + 1 / ((L : ℝ) + 1) lemma totalError_nonneg (s L : ℕ) : 0 ≤ totalError s L := Finset.sum_nonneg fun _ _ => le_max_left _ _ lemma pairError_le_total (s L : ℕ) (b c : Block s) : pairError s L b c ≤ totalError s L := (le_max_right _ _).trans (Finset.single_le_sum (f := fun bc : Block s × Block s => max 0 (pairError s L bc.1 bc.2)) (fun _ _ => le_max_left _ _) (Finset.mem_univ (b, c))) lemma totalError_tendsto {s : ℕ} (hs : 0 < s) : Tendsto (totalError s) atTop (𝓝 0) := by unfold totalError have h := tendsto_finset_sum (Finset.univ : Finset (Block s × Block s)) (fun bc _ => (tendsto_const_nhds (x := (0 : ℝ))).max (pairError_tendsto hs bc.1 bc.2)) simpa [totalError] using h lemma tolerance_pos (s L : ℕ) : 0 < tolerance s L := add_pos_of_nonneg_of_pos (Real.sqrt_nonneg _) (by positivity) lemma tolerance_tendsto {s : ℕ} (hs : 0 < s) : Tendsto (tolerance s) atTop (𝓝 0) := by unfold tolerance have hL : Tendsto (fun L : ℕ => (L : ℝ) + 1) atTop atTop := tendsto_atTop_mono (fun L => by linarith) tendsto_natCast_atTop_atTop have h := ((totalError_tendsto hs).sqrt).add (tendsto_inv_atTop_zero.comp hL) simpa only [Function.comp_def, one_div, Real.sqrt_zero, zero_add] using h lemma error_div_tolerance (s L : ℕ) (b c : Block s) : pairError s L b c / tolerance s L ≤ Real.sqrt (totalError s L) := by apply (div_le_iff₀ (tolerance_pos s L)).mpr have hs := Real.sq_sqrt (totalError_nonneg s L) have hp : 0 ≤ Real.sqrt (totalError s L) * (1 / ((L : ℝ) + 1)) := by positivity have h := pairError_le_total s L b c dsimp [tolerance] nlinarith /-- The denominator counts the genuine local unit tuples. -/ def localCard {s : ℕ} (p : Axis s → ℕ) (S : Finset (Axis s)) : ℕ := ∏ i ∈ S, Nat.card (Residue (p i))ˣ lemma unitCard_lower (p : ℕ) (hp : p.Prime) (hi : p % 4 = 3) : (8 / 9 : ℝ) * (p : ℝ) ^ 2 ≤ (Nat.card (Residue p)ˣ : ℝ) := by rw [card_unit_group_inert p hp hi] have hp3 : 3 ≤ p := by omega have hp3r : (3 : ℝ) ≤ p := by exact_mod_cast hp3 have hp2 : 1 ≤ p ^ 2 := by nlinarith rw [Nat.cast_sub hp2, Nat.cast_pow, Nat.cast_one] nlinarith [sq_nonneg ((p : ℝ) - 3)] lemma localCard_lower {s : ℕ} (p : Axis s → ℕ) (hp : ∀ i, (p i).Prime) (hi : ∀ i, p i % 4 = 3) (S : Finset (Axis s)) (hS : S.card ≤ 4) : ((∏ i ∈ S, p i : ℕ) : ℝ) ^ 2 / 2 ≤ (localCard p S : ℝ) := by have hprod : (8 / 9 : ℝ) ^ S.card * ((∏ i ∈ S, p i : ℕ) : ℝ) ^ 2 ≤ (localCard p S : ℝ) := by rw [localCard, Nat.cast_prod, Nat.cast_prod] calc _ = ∏ i ∈ S, ((8 / 9 : ℝ) * (p i : ℝ) ^ 2) := by rw [Finset.prod_mul_distrib, Finset.prod_const, Finset.prod_pow] _ ≤ _ := Finset.prod_le_prod (fun _ _ => by positivity) (fun i _ => unitCard_lower (p i) (hp i) (hi i)) have hpow : (8 / 9 : ℝ) ^ 4 ≤ (8 / 9 : ℝ) ^ S.card := pow_le_pow_of_le_one (by norm_num) (by norm_num) hS exact (GaussianUnitCRT.half_square_le_four_fraction _).trans ((mul_le_mul_of_nonneg_right hpow (sq_nonneg _)).trans hprod) def eventSupport {s : ℕ} : Event s → Finset (Axis s) | .inl bc => pairSupport bc.1 bc.2 | .inr i => {i} def eventResidue {s : ℕ} (p : Axis s → ℕ) : Event s → Type | .inl bc => Residue (modulus p bc.1 bc.2) | .inr i => Residue (p i) def eventMap {s : ℕ} (p : Axis s → ℕ) : ∀ e : Event s, (∀ i : eventSupport e, (Residue (p i.1))ˣ) → eventResidue p e | .inl bc => localChoiceMap p bc.1 bc.2 | .inr i => fun u => (u ⟨i, Finset.mem_singleton_self i⟩ : Residue (p i)) lemma eventMap_injective {s : ℕ} (p : Axis s → ℕ) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (e : Event s) : Function.Injective (eventMap p e) := by cases e with | inl bc => exact localChoiceMap_injective p hp hd bc.1 bc.2 | inr i => intro u v h funext j obtain ⟨j, hj⟩ := j have hji : j = i := Finset.mem_singleton.mp hj subst j exact Units.ext h def eventBad (s L : ℕ) : ∀ e : Event s, Finset (eventResidue (primes s L) e) | .inl bc => if (bc.2.1.val, bc.2.2.val) ∈ DistanceCounts.highTargets s bc.1.1.val bc.1.2.val then ResidueExceptions.badHigh (modulus (primes s L) bc.1 bc.2) (modulus_pos _ (primes_prime s L) bc.1 bc.2) (pairRadius L (primes s L) bc.1 bc.2) (tolerance s L * (L : ℝ) ^ 2) else ResidueExceptions.badLow (modulus (primes s L) bc.1 bc.2) (modulus_pos _ (primes_prime s L) bc.1 bc.2) (pairRadius L (primes s L) bc.1 bc.2) (tolerance s L * (L : ℝ) ^ 2) | .inr i => ResidueExceptions.badProjectedUnits (primes s L i) (primes_prime s L i).pos (L : ZMod (primes s L i)) private theorem eventBad_pair_high (s L : ℕ) (b c : Block s) (hh : (c.1.val, c.2.val) ∈ DistanceCounts.highTargets s b.1.val b.2.val) : eventBad s L (.inl (b, c)) = ResidueExceptions.badHigh (modulus (primes s L) b c) (modulus_pos _ (primes_prime s L) b c) (pairRadius L (primes s L) b c) (tolerance s L * (L : ℝ) ^ 2) := by unfold eventBad exact if_pos hh private theorem eventBad_pair_low (s L : ℕ) (b c : Block s) (hh : (c.1.val, c.2.val) ∉ DistanceCounts.highTargets s b.1.val b.2.val) : eventBad s L (.inl (b, c)) = ResidueExceptions.badLow (modulus (primes s L) b c) (modulus_pos _ (primes_prime s L) b c) (pairRadius L (primes s L) b c) (tolerance s L * (L : ℝ) ^ 2) := by unfold eventBad exact if_neg hh lemma bad_pair_fraction (s L : ℕ) (hL : 0 < L) (b c : Block s) : ((eventBad s L (.inl (b, c))).card : ℝ) / (modulus (primes s L) b c : ℝ) ^ 2 ≤ 36 * Real.sqrt (totalError s L) := by have hLr : (0 : ℝ) < L := by exact_mod_cast hL have hnorm : ((eventBad s L (.inl (b, c))).card : ℝ) / (modulus (primes s L) b c : ℝ) ^ 2 ≤ 36 * (pairError s L b c / tolerance s L) := by by_cases hh : (c.1.val, c.2.val) ∈ DistanceCounts.highTargets s b.1.val b.2.val · rw [eventBad_pair_high s L b c hh] have h := ResidueExceptions.badHigh_normalized (modulus (primes s L) b c) (modulus_pos _ (primes_prime s L) b c) (show (0 : ℝ) < 6 by norm_num) hLr (tolerance_pos s L) (show pairRadius L (primes s L) b c = 6 * (modulus (primes s L) b c : ℝ) * L from rfl) convert h using 1 <;> norm_num [pairError, hh, mul_div_assoc] rfl · rw [eventBad_pair_low s L b c hh] have h := ResidueExceptions.badLow_normalized (modulus (primes s L) b c) (modulus_pos _ (primes_prime s L) b c) (show (0 : ℝ) < 6 by norm_num) hLr (tolerance_pos s L) (show pairRadius L (primes s L) b c = 6 * (modulus (primes s L) b c : ℝ) * L from rfl) convert h using 1 <;> norm_num [pairError, hh, mul_div_assoc] rfl exact hnorm.trans (mul_le_mul_of_nonneg_left (error_div_tolerance s L b c) (by norm_num)) private lemma fraction_le_twice {B Q D : ℝ} (hB : 0 ≤ B) (hQ : 0 < Q) (hD : Q ^ 2 / 2 ≤ D) : B / D ≤ 2 * (B / Q ^ 2) := by calc _ ≤ B / (Q ^ 2 / 2) := div_le_div_of_nonneg_left hB (by positivity) hD _ = _ := by ring def eventBound (s L : ℕ) : Event s → ℝ | .inl _ => 72 * Real.sqrt (totalError s L) | .inr i => 2 / (primes s L i : ℝ) lemma event_fraction_le (s L : ℕ) (hL : 0 < L) (e : Event s) : ((eventBad s L e).card : ℝ) / (localCard (primes s L) (eventSupport e) : ℝ) ≤ eventBound s L e := by cases e with | inl bc => have hd := localCard_lower (primes s L) (primes_prime s L) (primes_inert s L) (pairSupport bc.1 bc.2) (pairSupport_card_le_four bc.1 bc.2) have hq : (0 : ℝ) < modulus (primes s L) bc.1 bc.2 := by exact_mod_cast modulus_pos _ (primes_prime s L) bc.1 bc.2 have h := (fraction_le_twice (Nat.cast_nonneg _) hq hd).trans (mul_le_mul_of_nonneg_left (bad_pair_fraction s L hL bc.1 bc.2) (by norm_num)) simpa only [eventSupport, eventBound, ← mul_assoc, show (2 : ℝ) * 36 = 72 by norm_num] using h | inr i => have hp : (0 : ℝ) < primes s L i := by exact_mod_cast (primes_prime s L i).pos have hd := localCard_lower (primes s L) (primes_prime s L) (primes_inert s L) {i} (by simp) simp only [Finset.prod_singleton] at hd have hcard : ((eventBad s L (.inr i)).card : ℝ) ≤ primes s L i := by exact_mod_cast ResidueExceptions.badProjectedUnits_card_le (primes s L i) (primes_prime s L i) (L : ZMod (primes s L i)) calc _ ≤ 2 * (((eventBad s L (.inr i)).card : ℝ) / (primes s L i : ℝ) ^ 2) := fraction_le_twice (Nat.cast_nonneg _) hp hd _ ≤ 2 * ((primes s L i : ℝ) / (primes s L i : ℝ) ^ 2) := mul_le_mul_of_nonneg_left (div_le_div_of_nonneg_right hcard (sq_nonneg _)) (by norm_num) _ = eventBound s L (.inr i) := by dsimp [eventBound] field_simp [hp.ne'] <;> ring lemma eventBound_tendsto {s : ℕ} (hs : 0 < s) (e : Event s) : Tendsto (fun L => eventBound s L e) atTop (𝓝 0) := by cases e with | inl bc => simpa [eventBound] using ((totalError_tendsto hs).sqrt).const_mul 72 | inr i => exact tendsto_const_nhds.div_atTop (primes_tendsto hs i) lemma event_sum_small {s : ℕ} (hs : 0 < s) : ∀ᶠ L in atTop, (∑ e : Event s, eventBound s L e) < 1 := by have h := tendsto_finset_sum (Finset.univ : Finset (Event s)) (fun e _ => eventBound_tendsto hs e) simp only [Finset.sum_const_zero] at h exact h.eventually (gt_mem_nhds (show (0 : ℝ) < 1 by norm_num)) lemma eventually_exists_units {s : ℕ} (hs : 0 < s) : ∀ᶠ L in atTop, ∃ ω : ∀ i : Axis s, (Residue (primes s L i))ˣ, ∀ e : Event s, eventMap (primes s L) e (fun i : eventSupport e => ω i.1) ∉ eventBad s L e := by filter_upwards [primes_injective hs, event_sum_small hs, eventually_gt_atTop (0 : ℕ)] with L hd hsmall hL letI : ∀ i : Axis s, Finite (Residue (primes s L i)) := fun i => finite_residue _ (primes_prime s L i).pos letI : ∀ i : Axis s, Fintype (Residue (primes s L i))ˣ := fun _ => Fintype.ofFinite _ apply FiniteCoordinateSelection.exists_avoiding (fun i : Axis s => (Residue (primes s L i))ˣ) eventSupport (eventResidue (primes s L)) (eventMap (primes s L)) (eventMap_injective _ (primes_prime s L) hd) (eventBad s L) have h := (Finset.sum_le_sum (fun e (_ : e ∈ (Finset.univ : Finset (Event s))) => event_fraction_le s L hL e)).trans_lt hsmall simpa only [localCard, Nat.card_eq_fintype_card] using h /-- The finite prefix uses genuine unit classes, never substitute primes. -/ def selectedUnits (s L : ℕ) : ∀ i : Axis s, (Residue (primes s L i))ˣ := if h : ∃ ω : ∀ i : Axis s, (Residue (primes s L i))ˣ, ∀ e : Event s, eventMap (primes s L) e (fun i : eventSupport e => ω i.1) ∉ eventBad s L e then Classical.choose h else fun _ => 1 lemma selectedUnits_avoid {s : ℕ} (hs : 0 < s) : ∀ᶠ L in atTop, ∀ e : Event s, eventMap (primes s L) e (fun i : eventSupport e => selectedUnits s L i.1) ∉ eventBad s L e := by filter_upwards [eventually_exists_units hs] with L h simpa only [selectedUnits, dif_pos h] using Classical.choose_spec h /-- Every coordinate, including the finite prefix, is an actual bounded lift. -/ def offsets (s L : ℕ) (i : Axis s) : GaussianInt := BoundedResidueLift.lift (primes s L i) (selectedUnits s L i) lemma offsets_residue (s L : ℕ) (i : Axis s) : GaussianNorm.residue (primes s L i) (offsets s L i) = (selectedUnits s L i : Residue (primes s L i)) := BoundedResidueLift.residue_lift _ (primes_prime s L i).pos _ lemma offsets_bounded (s L : ℕ) : BoundedOffsets (primes s L) (offsets s L) := boundedOffsets_lift _ (primes_prime s L) _ lemma offsets_unit (s L : ℕ) (i : Axis s) : IsUnit (GaussianNorm.residue (primes s L i) (offsets s L i)) := by rw [offsets_residue] exact (selectedUnits s L i).isUnit lemma eventually_admissible {s : ℕ} (hs : 0 < s) : ∀ᶠ L in atTop, Admissible s L (primes s L) (offsets s L) (tolerance s L) := by filter_upwards [selectedUnits_avoid hs, primes_injective hs] with L havoid hd refine ⟨primes_prime s L, primes_inert s L, hd, offsets_unit s L, offsets_bounded s L, ?_, (tolerance_pos s L).le, ?_⟩ · intro i hdiv apply havoid (.inr i) apply (ResidueExceptions.mem_badProjectedUnits _ (primes_prime s L i).pos (L : ZMod (primes s L i)) (selectedUnits s L i)).mpr refine ⟨(selectedUnits s L i).isUnit, ?_⟩ have hz := (ZMod.intCast_zmod_eq_zero_iff_dvd (OffsetSeparation.projectionNumerator (L : ℤ) (offsets s L i)) (primes s L i)).mpr hdiv rw [offsets, BoundedResidueLift.projection_lift _ (primes_prime s L i).pos] at hz simpa only [Int.cast_natCast] using hz · intro b c have he := localChoiceMap_eq_numerator (primes s L) (primes_prime s L) hd b c (fun i : pairSupport b c => selectedUnits s L i.1) (offsets s L) (fun i => offsets_residue s L i.1) have h := havoid (.inl (b, c)) change localChoiceMap (primes s L) b c (fun i : pairSupport b c => selectedUnits s L i.1) ∉ _ at h rw [he] at h change pairResidue (primes s L) (offsets s L) b c ∉ eventBad s L (.inl (b, c)) at h by_cases hh : (c.1.val, c.2.val) ∈ DistanceCounts.highTargets s b.1.val b.2.val · rw [eventBad_pair_high s L b c hh] at h simpa only [if_pos hh] using ResidueExceptions.collisionFiber_card_le_of_not_badHigh h · rw [eventBad_pair_low s L b c hh] at h simpa only [if_neg hh] using ResidueExceptions.palette_card_le_of_not_badLow h /-- Unconditional simultaneous arithmetic and palette selection on the full even grid. -/ theorem exists_admissible_family {s : ℕ} (hs : 0 < s) : ∃ p : ℕ → Axis s → ℕ, ∃ z : ℕ → Axis s → GaussianInt, ∃ ε : ℕ → ℝ, Tendsto ε atTop (𝓝 0) ∧ (∀ L i, (p L i).Prime ∧ p L i % 4 = 3) ∧ (∀ L, BoundedOffsets (p L) (z L)) ∧ (∀ᶠ L in atTop, Admissible s L (p L) (z L) (ε L)) := ⟨primes s, offsets s, tolerance s, tolerance_tendsto hs, fun L i => ⟨primes_prime s L i, primes_inert s L i⟩, offsets_bounded s, eventually_admissible hs⟩ end DistanceCounts.OffsetSelection end end BodyFile053 -- Source: DistanceCounts/Dictionary.lean section BodyFile054 /-! Compressed rational dictionary controls, conditional on explicit marker avoidance. -/ noncomputable section open scoped BigOperators namespace DistanceCounts namespace Dictionary /-- Distinct rational block residues, stated without choosing representatives. -/ def DistinctResidues {B : Type*} (σ : B → ℚ) : Prop := ∀ b c (z : ℤ), σ b - σ c = z → b = c /-- Distinct residues and Euclidean chunk decomposition give distinct labels. The chunk index is unbounded here, so zero-padding introduces no exception. -/ theorem chunk_labels_injective {B : Type*} (σ : B → ℚ) (ell : ℕ) (hσ : DistinctResidues σ) : Function.Injective (fun a : (B × ℕ) × Fin ell => σ a.1.1 + (ell : ℚ) * a.1.2 + a.2.val) := by rintro ⟨⟨b, k⟩, j⟩ ⟨⟨c, l⟩, i⟩ heq have hbc : b = c := by apply hσ b c ((ell : ℤ) * l + i.val - (ell : ℤ) * k - j.val) push_cast dsimp at heq linarith subst c have hn : ell * k + j.val = ell * l + i.val := by have hq : (ell : ℚ) * k + j.val = (ell : ℚ) * l + i.val := by dsimp at heq linarith exact_mod_cast hq have hk : k = l := by rcases lt_trichotomy k l with hlt | heq | hgt · have hm := Nat.mul_le_mul_left ell (Nat.succ_le_of_lt hlt) nlinarith [j.isLt, i.isLt] · exact heq · have hm := Nat.mul_le_mul_left ell (Nat.succ_le_of_lt hgt) nlinarith [j.isLt, i.isLt] subst l have hj : j = i := Fin.ext (by omega) subst i rfl /-- All pattern/active-position pairs. Repeated patterns share the same left controls, which is the dictionary compression. -/ def leftIndices (ell : ℕ) : Finset (Finset (Fin ell) × Fin ell) := by classical exact Finset.univ.filter fun a => a.2 ∈ a.1 def leftLabel {ell : ℕ} (marker : Finset (Fin ell) → ℚ) (a : Finset (Fin ell) × Fin ell) : ℚ := marker a.1 + a.2.val def rightLabel {C : Type*} {ell : ℕ} (base : C → ℚ) (mask : C → Finset (Fin ell)) (marker : Finset (Fin ell) → ℚ) (c : C) : ℚ := base c - marker (mask c) /-- Explicit finite avoidance condition, not an assumption that the desired pair counts exist. With finite `C`, these are finitely many forbidden marker differences. Marker existence is separate from the counting theorem. -/ def MarkerAvoidance {C : Type*} {ell : ℕ} (base : C → ℚ) (marker : Finset (Fin ell) → ℚ) : Prop := ∀ P Q : Finset (Fin ell), P ≠ Q → ∀ c d : C, ∀ j i : Fin ell, marker P - marker Q ≠ (base d + i.val) - (base c + j.val) /-- Matching-pattern cancellation plus the avoidance condition excludes every wrong pattern, chunk, block, and position. -/ theorem matching_iff_of_markerAvoidance {C : Type*} {ell : ℕ} (base : C → ℚ) (mask : C → Finset (Fin ell)) (marker : Finset (Fin ell) → ℚ) (hinj : Function.Injective (fun a : C × Fin ell => base a.1 + a.2.val)) (havoid : MarkerAvoidance base marker) (a : Finset (Fin ell) × Fin ell) (c d : C) (i : Fin ell) : leftLabel marker a + rightLabel base mask marker c = base d + i.val ↔ a.1 = mask d ∧ c = d ∧ a.2 = i := by constructor · intro heq have hP : a.1 = mask c := by by_contra hne apply havoid a.1 (mask c) hne c d a.2 i dsimp [leftLabel, rightLabel] at heq linarith have hl : base c + a.2.val = base d + i.val := by dsimp [leftLabel, rightLabel] at heq rw [hP] at heq linarith have hci := @hinj (c, a.2) (d, i) hl have hc : c = d := congrArg Prod.fst hci have hi : a.2 = i := congrArg Prod.snd hci exact ⟨hP.trans (congrArg mask hc), hc, hi⟩ · rintro ⟨hP, rfl, hi⟩ dsimp [leftLabel, rightLabel] rw [hP, hi] ring /-- The actual rational controls on the left and right sides. -/ def leftControls {ell : ℕ} (marker : Finset (Fin ell) → ℚ) : Finset ℚ := (leftIndices ell).image (leftLabel marker) def rightControls {C : Type*} [Fintype C] {ell : ℕ} (base : C → ℚ) (mask : C → Finset (Fin ell)) (marker : Finset (Fin ell) → ℚ) : Finset ℚ := Finset.univ.image (rightLabel base mask marker) /-- The finite, non-asymptotic compression bound underlying (29). -/ theorem controls_card_le {C : Type*} [Fintype C] {ell : ℕ} (base : C → ℚ) (mask : C → Finset (Fin ell)) (marker : Finset (Fin ell) → ℚ) : (leftControls marker).card + (rightControls base mask marker).card ≤ ell * 2 ^ ell + Fintype.card C := by classical have hleft : (leftControls marker).card ≤ ell * 2 ^ ell := by calc _ ≤ (leftIndices ell).card := Finset.card_image_le _ ≤ (Finset.univ : Finset (Finset (Fin ell) × Fin ell)).card := Finset.card_filter_le _ _ _ = ell * 2 ^ ell := by simp [Nat.mul_comm] have hright : (rightControls base mask marker).card ≤ Fintype.card C := by simpa only [rightControls, Finset.card_univ] using (Finset.card_image_le (s := (Finset.univ : Finset C)) (f := rightLabel base mask marker)) exact Nat.add_le_add hleft hright /-- Ordered cross-side pairs of actual rational scalar labels, not merely an indexed multiplicity. Geometric midpoint coordinates use twice these labels. -/ def crossPairs {C : Type*} [Fintype C] {ell : ℕ} (base : C → ℚ) (mask : C → Finset (Fin ell)) (marker : Finset (Fin ell) → ℚ) (d : C) (i : Fin ell) : Finset (ℚ × ℚ) := ((leftControls marker).product (rightControls base mask marker)).filter fun p => p.1 + p.2 = base d + i.val /-- The constructed dictionary realizes a prescribed bit exactly, subject only to the displayed finite avoidance condition. No existence of pair counts is postulated, and coincident indexed controls are not counted repeatedly. -/ theorem crossPairs_eq_of_markerAvoidance {C : Type*} [Fintype C] {ell : ℕ} (base : C → ℚ) (mask : C → Finset (Fin ell)) (marker : Finset (Fin ell) → ℚ) (hinj : Function.Injective (fun a : C × Fin ell => base a.1 + a.2.val)) (havoid : MarkerAvoidance base marker) (d : C) (i : Fin ell) : crossPairs base mask marker d i = if i ∈ mask d then {(leftLabel marker (mask d, i), rightLabel base mask marker d)} else ∅ := by classical apply Finset.ext intro p constructor · intro hp obtain ⟨hprod, hsum⟩ := Finset.mem_filter.mp hp obtain ⟨hleft, hright⟩ := Finset.mem_product.mp hprod obtain ⟨a, ha, hpa⟩ := Finset.mem_image.mp hleft obtain ⟨c, hcuniv, hpc⟩ := Finset.mem_image.mp hright have hm : leftLabel marker a + rightLabel base mask marker c = base d + i.val := by rw [hpa, hpc] exact hsum rcases (matching_iff_of_markerAvoidance base mask marker hinj havoid a c d i).mp hm with ⟨hP, hc, hi⟩ have hbit : i ∈ mask d := by have hactive : a.2 ∈ a.1 := (Finset.mem_filter.mp ha).2 simpa only [hP, hi] using hactive rw [if_pos hbit, Finset.mem_singleton] apply Prod.ext · rw [← hpa] simp [leftLabel, hP, hi] · rw [← hpc, hc] · intro hp by_cases hbit : i ∈ mask d · rw [if_pos hbit, Finset.mem_singleton] at hp subst p have hleft : leftLabel marker (mask d, i) ∈ leftControls marker := Finset.mem_image.mpr ⟨(mask d, i), by simp [leftIndices, hbit], rfl⟩ have hright : rightLabel base mask marker d ∈ rightControls base mask marker := Finset.mem_image.mpr ⟨d, Finset.mem_univ d, rfl⟩ apply Finset.mem_filter.mpr refine ⟨Finset.mem_product.mpr ⟨hleft, hright⟩, ?_⟩ dsimp [leftLabel, rightLabel] ring · simp [hbit] at hp theorem crossPairs_card_of_markerAvoidance {C : Type*} [Fintype C] {ell : ℕ} (base : C → ℚ) (mask : C → Finset (Fin ell)) (marker : Finset (Fin ell) → ℚ) (hinj : Function.Injective (fun a : C × Fin ell => base a.1 + a.2.val)) (havoid : MarkerAvoidance base marker) (d : C) (i : Fin ell) : (crossPairs base mask marker d i).card = if i ∈ mask d then 1 else 0 := by classical rw [crossPairs_eq_of_markerAvoidance base mask marker hinj havoid] split <;> simp /-- Unary masks use zero-based levels: exactly `q` of the first `H` masks are active whenever `q ≤ H`. -/ theorem unary_sum (H q : ℕ) (hq : q ≤ H) : (∑ h ∈ Finset.range H, if h < q then 1 else 0 : ℕ) = q := by rw [Finset.sum_boole] have heq : (Finset.range H).filter (fun h => h < q) = Finset.range q := by ext h simp only [Finset.mem_filter, Finset.mem_range] omega simp only [heq, Finset.card_range, Nat.cast_id] /-- Applying the proved binary construction at each unary level gives the prescribed integer as the sum of actual cross-pair counts. Combining levels on one physical line additionally requires exclusion of cross-level pairs. -/ theorem unary_crossPairs_sum_of_markerAvoidance {C : Type*} [Fintype C] {ell : ℕ} (H : ℕ) (base : C → ℚ) (q : C → Fin ell → ℕ) (marker : ℕ → Finset (Fin ell) → ℚ) (hinj : Function.Injective (fun a : C × Fin ell => base a.1 + a.2.val)) (havoid : ∀ h < H, MarkerAvoidance base (marker h)) (d : C) (i : Fin ell) (hq : q d i ≤ H) : (∑ h ∈ Finset.range H, (crossPairs base (fun c => Finset.univ.filter (fun j => h < q c j)) (marker h) d i).card) = q d i := by classical calc _ = ∑ h ∈ Finset.range H, if h < q d i then 1 else 0 := by apply Finset.sum_congr rfl intro h hh rw [crossPairs_card_of_markerAvoidance base _ (marker h) hinj (havoid h (Finset.mem_range.mp hh))] simp _ = q d i := unary_sum H (q d i) hq end Dictionary end DistanceCounts end end BodyFile054 -- Source: DistanceCounts/MarkerExistence.lean section BodyFile055 /-! Explicit finite rational markers, including cross-level and same-side exclusions. -/ noncomputable section open scoped BigOperators namespace DistanceCounts namespace Dictionary /-- Positive multiples of a spacing, indexed by an enumeration of any finite tag type. In particular a tag can include both a unary level and a pattern. -/ def spacedMarker (T : Type*) [Fintype T] (S : ℚ) (t : T) : ℚ := S * ((Fintype.equivFin T t).val + 1) theorem spacedMarker_lower_bound (T : Type*) [Fintype T] (S : ℚ) (hS : 0 ≤ S) (t : T) : S ≤ spacedMarker T S t := by have hn : (0 : ℚ) ≤ (Fintype.equivFin T t).val := Nat.cast_nonneg _ have hm := mul_nonneg hS hn dsimp [spacedMarker] nlinarith /-- Distinct enumerated tags differ by at least one full spacing. -/ theorem spacedMarker_separation (T : Type*) [Fintype T] (S : ℚ) (hS : 0 ≤ S) (t u : T) (htu : t ≠ u) : S ≤ |spacedMarker T S t - spacedMarker T S u| := by have hne : (Fintype.equivFin T t).val ≠ (Fintype.equivFin T u).val := by intro heq exact htu ((Fintype.equivFin T).injective (Fin.ext heq)) rcases lt_or_gt_of_ne hne with hlt | hgt · have hstep : (Fintype.equivFin T t).val + (1 : ℚ) ≤ (Fintype.equivFin T u).val := by exact_mod_cast Nat.succ_le_of_lt hlt have hm := mul_le_mul_of_nonneg_left hstep hS have ha := neg_le_abs (spacedMarker T S t - spacedMarker T S u) dsimp [spacedMarker] at ha ⊢ nlinarith · have hstep : (Fintype.equivFin T u).val + (1 : ℚ) ≤ (Fintype.equivFin T t).val := by exact_mod_cast Nat.succ_le_of_lt hgt have hm := mul_le_mul_of_nonneg_left hstep hS have ha := le_abs_self (spacedMarker T S t - spacedMarker T S u) dsimp [spacedMarker] at ha ⊢ nlinarith /-- A finite-tag separation theorem independent of any dictionary labels. -/ theorem exists_finite_tag_separation (T : Type*) [Fintype T] (S : ℚ) (hS : 0 ≤ S) : ∃ marker : T → ℚ, (∀ t, S ≤ marker t) ∧ ∀ t u, t ≠ u → S ≤ |marker t - marker u| := by exact ⟨spacedMarker T S, spacedMarker_lower_bound T S hS, spacedMarker_separation T S hS⟩ /-- A strict bound for all base labels and all positions in their chunks. -/ def markerBaseBound {C : Type*} [Fintype C] (base : C → ℚ) (ell : ℕ) : ℚ := (∑ c, |base c|) + ell + 1 theorem markerBaseBound_pos {C : Type*} [Fintype C] (base : C → ℚ) (ell : ℕ) : 0 < markerBaseBound base ell := by have hs : 0 ≤ ∑ c, |base c| := Finset.sum_nonneg (fun c _ => abs_nonneg (base c)) have he : (0 : ℚ) ≤ ell := Nat.cast_nonneg _ dsimp [markerBaseBound] linarith theorem base_bounds {C : Type*} [Fintype C] (base : C → ℚ) (ell : ℕ) (c : C) : -markerBaseBound base ell < base c ∧ base c < markerBaseBound base ell := by classical have hs : |base c| ≤ ∑ d, |base d| := Finset.single_le_sum (fun d _ => abs_nonneg (base d)) (Finset.mem_univ c) have hp := le_abs_self (base c) have hn := neg_le_abs (base c) have he : (0 : ℚ) ≤ ell := Nat.cast_nonneg _ dsimp [markerBaseBound] constructor <;> linarith theorem original_label_bounds {C : Type*} [Fintype C] (base : C → ℚ) {ell : ℕ} (c : C) (j : Fin ell) : -markerBaseBound base ell < base c + j.val ∧ base c + j.val < markerBaseBound base ell := by classical have hs : |base c| ≤ ∑ d, |base d| := Finset.single_le_sum (fun d _ => abs_nonneg (base d)) (Finset.mem_univ c) have hp := le_abs_self (base c) have hn := neg_le_abs (base c) have hj : (j.val : ℚ) < ell := by exact_mod_cast j.isLt have hj0 : (0 : ℚ) ≤ j.val := Nat.cast_nonneg _ have he : (0 : ℚ) ≤ ell := Nat.cast_nonneg _ dsimp [markerBaseBound] constructor <;> linarith /-- The factor four simultaneously separates different tags, puts opposite sides beyond an arbitrary requested radius, and excludes same-side sums. -/ def safeMarker {C : Type*} [Fintype C] (base : C → ℚ) (ell : ℕ) (R : ℚ) (T : Type*) [Fintype T] : T → ℚ := spacedMarker T (4 * (markerBaseBound base ell + |R|)) theorem safeMarker_lower_bound {C T : Type*} [Fintype C] [Fintype T] (base : C → ℚ) (ell : ℕ) (R : ℚ) (t : T) : 4 * (markerBaseBound base ell + |R|) ≤ safeMarker base ell R T t := by apply spacedMarker_lower_bound have hb := markerBaseBound_pos base ell have hr := abs_nonneg R linarith /-- All different finite tags are excluded, not just different patterns at a fixed level. Taking `T = Fin H × Finset (Fin ell)` excludes cross-level sums. -/ theorem safeMarker_avoidance {C T : Type*} [Fintype C] [Fintype T] (base : C → ℚ) {ell : ℕ} (R : ℚ) (t u : T) (htu : t ≠ u) (c d : C) (j i : Fin ell) : safeMarker base ell R T t - safeMarker base ell R T u ≠ (base d + i.val) - (base c + j.val) := by have hb := markerBaseBound_pos base ell have hr := abs_nonneg R have hs : 0 ≤ 4 * (markerBaseBound base ell + |R|) := by linarith have hgap := spacedMarker_separation T _ hs t u htu change 4 * (markerBaseBound base ell + |R|) ≤ |safeMarker base ell R T t - safeMarker base ell R T u| at hgap rcases original_label_bounds base c j with ⟨hc0, hc1⟩ rcases original_label_bounds base d i with ⟨hd0, hd1⟩ have hsmall : |(base d + i.val) - (base c + j.val)| < 2 * markerBaseBound base ell := by apply abs_lt.mpr constructor <;> linarith intro heq rw [heq] at hgap linarith /-- The same construction works uniformly for any finite tag type, with no hypotheses on the base labels or on their injectivity. -/ theorem exists_tag_markerAvoidance {C T : Type*} [Fintype C] [Fintype T] (base : C → ℚ) (ell : ℕ) : ∃ marker : T → ℚ, ∀ t u, t ≠ u → ∀ c d : C, ∀ j i : Fin ell, marker t - marker u ≠ (base d + i.val) - (base c + j.val) := by exact ⟨safeMarker base ell 0 T, safeMarker_avoidance base 0⟩ /-- The dictionary's finite avoidance hypothesis always has rational witnesses. -/ theorem exists_markerAvoidance {C : Type*} [Fintype C] (base : C → ℚ) (ell : ℕ) : ∃ marker : Finset (Fin ell) → ℚ, MarkerAvoidance base marker := by exact exists_tag_markerAvoidance base ell theorem safeMarker_left_far {C T : Type*} [Fintype C] [Fintype T] (base : C → ℚ) {ell : ℕ} (R : ℚ) (t : T) (j : Fin ell) : |R| + markerBaseBound base ell < safeMarker base ell R T t + j.val := by have hm := safeMarker_lower_bound base ell R t have hb := markerBaseBound_pos base ell have hr := abs_nonneg R have hj : (0 : ℚ) ≤ j.val := Nat.cast_nonneg _ linarith theorem safeMarker_right_far {C T : Type*} [Fintype C] [Fintype T] (base : C → ℚ) (ell : ℕ) (R : ℚ) (t : T) (c : C) : base c - safeMarker base ell R T t < -(|R| + markerBaseBound base ell) := by have hm := safeMarker_lower_bound base ell R t have hb := markerBaseBound_pos base ell have hr := abs_nonneg R have hc := (base_bounds base ell c).2 linarith /-- No sum of two positive-side labels is an original label, even if the two controls coincide or have different unary levels. -/ theorem safeMarker_left_sum_ne {C T : Type*} [Fintype C] [Fintype T] (base : C → ℚ) {ell : ℕ} (R : ℚ) (t u : T) (j i : Fin ell) (c : C) (k : Fin ell) : (safeMarker base ell R T t + j.val) + (safeMarker base ell R T u + i.val) ≠ base c + k.val := by have ht := safeMarker_left_far base R t j have hu := safeMarker_left_far base R u i have hc := (original_label_bounds base c k).2 have hb := markerBaseBound_pos base ell have hr := abs_nonneg R linarith /-- No sum of two negative-side labels is an original label. -/ theorem safeMarker_right_sum_ne {C T : Type*} [Fintype C] [Fintype T] (base : C → ℚ) {ell : ℕ} (R : ℚ) (t u : T) (c d e : C) (k : Fin ell) : (base c - safeMarker base ell R T t) + (base d - safeMarker base ell R T u) ≠ base e + k.val := by have ht := safeMarker_right_far base ell R t c have hu := safeMarker_right_far base ell R u d have he := (original_label_bounds base e k).1 have hb := markerBaseBound_pos base ell have hr := abs_nonneg R linarith theorem safeMarker_sides_ne {C T : Type*} [Fintype C] [Fintype T] (base : C → ℚ) {ell : ℕ} (R : ℚ) (t u : T) (j : Fin ell) (c : C) : safeMarker base ell R T t + j.val ≠ base c - safeMarker base ell R T u := by have ht := safeMarker_left_far base R t j have hu := safeMarker_right_far base ell R u c have hb := markerBaseBound_pos base ell have hr := abs_nonneg R linarith /-- Disjointness for the actual dictionary control sets, rather than just their indexed labels. This includes the empty-chunk case. -/ theorem safeMarker_controls_disjoint {C : Type*} [Fintype C] (base : C → ℚ) {ell : ℕ} (mask : C → Finset (Fin ell)) (R : ℚ) : Disjoint (leftControls (safeMarker base ell R (Finset (Fin ell)))) (rightControls base mask (safeMarker base ell R (Finset (Fin ell)))) := by classical apply Finset.disjoint_left.mpr intro x hx hy rcases Finset.mem_image.mp hx with ⟨a, ha, hax⟩ rcases Finset.mem_image.mp hy with ⟨c, hc, hcx⟩ have heq := hax.trans hcx.symm exact safeMarker_sides_ne base R a.1 (mask c) a.2 c heq /-- Explicit exclusion of mixed unary levels on one line. It requires neither distinctness of the two patterns nor a geometric realization assumption. -/ theorem safeMarker_cross_level_ne {C : Type*} [Fintype C] (base : C → ℚ) {ell H : ℕ} (R : ℚ) (h k : Fin H) (hhk : h ≠ k) (P Q : Finset (Fin ell)) (c d : C) (j i : Fin ell) : (safeMarker base ell R (Fin H × Finset (Fin ell)) (h, P) + j.val) + (base c - safeMarker base ell R (Fin H × Finset (Fin ell)) (k, Q)) ≠ base d + i.val := by have htags : (h, P) ≠ (k, Q) := by intro heq exact hhk (congrArg Prod.fst heq) have havoid := safeMarker_avoidance base R (h, P) (k, Q) htags c d j i intro heq apply havoid linarith end Dictionary end DistanceCounts end end BodyFile055 -- Source: DistanceCounts/UnaryControls.lean section BodyFile056 /-! Joint rational unary controls. All levels use one finite set of safe markers; indexed witnesses are distinguished from the actual rational controls. -/ noncomputable section open scoped BigOperators namespace DistanceCounts namespace UnaryControls open Dictionary /-- The zero-based unary mask of a chunk at a level. -/ def mask {C : Type*} {ell H : ℕ} (q : C → Fin ell → ℕ) (h : Fin H) (c : C) : Finset (Fin ell) := Finset.univ.filter fun j => h.val < q c j /-- Tags include the level, so their separation applies across the whole line. -/ def marker {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (R : ℚ) (h : Fin H) (P : Finset (Fin ell)) : ℚ := safeMarker base ell R (Fin H × Finset (Fin ell)) (h, P) def left {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (R : ℚ) : Finset ℚ := by classical exact ((Finset.univ : Finset (Fin H)).product (leftIndices ell)).image (fun a => leftLabel (marker base R a.1) a.2) def right {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → Fin ell → ℕ) (R : ℚ) : Finset ℚ := by classical exact (Finset.univ : Finset (Fin H × C)).image (fun a => rightLabel base (mask q a.1) (marker base R a.1) a.2) /-- Actual ordered cross pairs of scalar controls, without indexed multiplicity. -/ def pairs (A B : Finset ℚ) (s : ℚ) : Finset (ℚ × ℚ) := (A.product B).filter fun p => p.1 + p.2 = s /-- A surviving indexed witness at a pin. It becomes an actual pair only when this level is active. -/ def witness {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → Fin ell → ℕ) (R : ℚ) (d : C) (i : Fin ell) (h : Fin H) : ℚ × ℚ := (leftLabel (marker base R h) (mask q h d, i), rightLabel base (mask q h) (marker base R h) d) /-- A cross match forces equality of the entire level-pattern tag, then of chunk and position. This excludes all cross-level matches on the same line. -/ theorem matching_iff {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → Fin ell → ℕ) (R : ℚ) (hinj : Function.Injective (fun a : C × Fin ell => base a.1 + a.2.val)) (h k : Fin H) (a : Finset (Fin ell) × Fin ell) (c d : C) (i : Fin ell) : leftLabel (marker base R h) a + rightLabel base (mask q k) (marker base R k) c = base d + i.val ↔ h = k ∧ a.1 = mask q k d ∧ c = d ∧ a.2 = i := by constructor · intro heq have htag : (h, a.1) = (k, mask q k c) := by by_contra hne have ha := safeMarker_avoidance base R (h, a.1) (k, mask q k c) hne c d a.2 i apply ha dsimp [leftLabel, rightLabel, marker] at heq linarith have hhk : h = k := congrArg Prod.fst htag have hP : a.1 = mask q k c := congrArg Prod.snd htag subst k have hl : base c + a.2.val = base d + i.val := by dsimp [leftLabel, rightLabel] at heq rw [hP] at heq linarith have hci := @hinj (c, a.2) (d, i) hl have hc : c = d := congrArg Prod.fst hci have hi : a.2 = i := congrArg Prod.snd hci exact ⟨rfl, hP.trans (congrArg (mask q h) hc), hc, hi⟩ · rintro ⟨rfl, hP, rfl, hi⟩ dsimp [leftLabel, rightLabel] rw [hP, hi] ring /-- Safe markers make the actual witnesses at different levels distinct. -/ theorem witness_injective {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → Fin ell → ℕ) (R : ℚ) (d : C) (i : Fin ell) : Function.Injective (witness (H := H) base q R d i) := by intro h k heq by_contra hne have ht : (h, mask q h d) ≠ (k, mask q k d) := by intro ht exact hne (congrArg Prod.fst ht) have ha := safeMarker_avoidance base R (h, mask q h d) (k, mask q k d) ht d d i i have he := congrArg Prod.fst heq dsimp [witness, leftLabel, marker] at he apply ha linarith /-- The combined cross-pair set is exactly the image of the active levels, rather than a formal sum of per-level cardinalities. -/ theorem pairs_eq {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → Fin ell → ℕ) (R : ℚ) (hinj : Function.Injective (fun a : C × Fin ell => base a.1 + a.2.val)) (d : C) (i : Fin ell) : pairs (left (ell := ell) (H := H) base R) (right (H := H) base q R) (base d + i.val) = ((Finset.univ : Finset (Fin H)).filter fun h => h.val < q d i).image (witness base q R d i) := by classical ext p constructor · intro hp obtain ⟨hpAB, hsum⟩ := Finset.mem_filter.mp hp obtain ⟨hpA, hpB⟩ := Finset.mem_product.mp hpAB obtain ⟨⟨h, a⟩, ha, hea⟩ := Finset.mem_image.mp hpA obtain ⟨⟨k, c⟩, _, heb⟩ := Finset.mem_image.mp hpB have hm : leftLabel (marker base R h) a + rightLabel base (mask q k) (marker base R k) c = base d + i.val := by rw [hea, heb] exact hsum obtain ⟨hhk, hP, hc, hi⟩ := (matching_iff base q R hinj h k a c d i).mp hm subst k subst c have hbit : h.val < q d i := by have hj : a.2 ∈ a.1 := (Finset.mem_filter.mp (Finset.mem_product.mp ha).2).2 rw [hP, hi] at hj exact (Finset.mem_filter.mp hj).2 refine Finset.mem_image.mpr ⟨h, by simp [hbit], ?_⟩ apply Prod.ext · change leftLabel (marker base R h) (mask q h d, i) = p.1 rw [← hea] simp only [leftLabel, hP, hi] · exact heb · intro hp obtain ⟨h, hh, rfl⟩ := Finset.mem_image.mp hp have hbit : i ∈ mask q h d := by simpa [mask] using (Finset.mem_filter.mp hh).2 apply Finset.mem_filter.mpr refine ⟨Finset.mem_product.mpr ⟨?_, ?_⟩, ?_⟩ · exact Finset.mem_image.mpr ⟨(h, (mask q h d, i)), by simp [leftIndices, hbit], rfl⟩ · exact Finset.mem_image.mpr ⟨(h, d), Finset.mem_univ _, rfl⟩ · dsimp [witness, leftLabel, rightLabel] ring theorem active_levels_card (H q : ℕ) (hq : q ≤ H) : ((Finset.univ : Finset (Fin H)).filter fun h => h.val < q).card = q := by classical have heq : (((Finset.univ : Finset (Fin H)).filter fun h => h.val < q).image Fin.val) = Finset.range q := by ext n simp only [Finset.mem_image, Finset.mem_filter, Finset.mem_univ, true_and, Finset.mem_range] constructor · rintro ⟨h, hh, rfl⟩ exact hh · intro hn exact ⟨⟨n, lt_of_lt_of_le hn hq⟩, hn, rfl⟩ rw [← Finset.card_image_of_injective _ Fin.val_injective, heq, Finset.card_range] /-- Exact unary correction on one scalar line, with no avoidance hypothesis. -/ theorem pairs_card {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → Fin ell → ℕ) (R : ℚ) (hinj : Function.Injective (fun a : C × Fin ell => base a.1 + a.2.val)) (d : C) (i : Fin ell) (hq : q d i ≤ H) : (pairs (left (ell := ell) (H := H) base R) (right (H := H) base q R) (base d + i.val)).card = q d i := by rw [pairs_eq base q R hinj d i, Finset.card_image_of_injective _ (witness_injective base q R d i)] exact active_levels_card H (q d i) hq theorem controls_disjoint {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → Fin ell → ℕ) (R : ℚ) : Disjoint (left (ell := ell) (H := H) base R) (right (H := H) base q R) := by classical apply Finset.disjoint_left.mpr intro x hx hy obtain ⟨⟨h, a⟩, _, hax⟩ := Finset.mem_image.mp hx obtain ⟨⟨k, c⟩, _, hcx⟩ := Finset.mem_image.mp hy exact safeMarker_sides_ne base R (h, a.1) (k, mask q k c) a.2 c (hax.trans hcx.symm) theorem left_sum_ne {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (R : ℚ) {x y : ℚ} (hx : x ∈ left (ell := ell) (H := H) base R) (hy : y ∈ left (ell := ell) (H := H) base R) (d : C) (i : Fin ell) : x + y ≠ base d + i.val := by classical obtain ⟨⟨h, a⟩, _, rfl⟩ := Finset.mem_image.mp hx obtain ⟨⟨k, b⟩, _, rfl⟩ := Finset.mem_image.mp hy exact safeMarker_left_sum_ne base R (h, a.1) (k, b.1) a.2 b.2 d i theorem right_sum_ne {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → Fin ell → ℕ) (R : ℚ) {x y : ℚ} (hx : x ∈ right (H := H) base q R) (hy : y ∈ right (H := H) base q R) (d : C) (i : Fin ell) : x + y ≠ base d + i.val := by classical obtain ⟨⟨h, c⟩, _, rfl⟩ := Finset.mem_image.mp hx obtain ⟨⟨k, e⟩, _, rfl⟩ := Finset.mem_image.mp hy exact safeMarker_right_sum_ne base R (h, mask q h c) (k, mask q k e) c e d i /-- Far placement is uniform across every level, without changing pair counts. -/ theorem controls_far {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → Fin ell → ℕ) (R : ℚ) : (∀ x ∈ left (ell := ell) (H := H) base R, |R| + markerBaseBound base ell < x) ∧ (∀ y ∈ right (H := H) base q R, y < -(|R| + markerBaseBound base ell)) := by classical constructor · intro x hx obtain ⟨⟨h, a⟩, _, rfl⟩ := Finset.mem_image.mp hx exact safeMarker_left_far base R (h, a.1) a.2 · intro y hy obtain ⟨⟨h, c⟩, _, rfl⟩ := Finset.mem_image.mp hy exact safeMarker_right_far base ell R (h, mask q h c) c theorem controls_card_le {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → Fin ell → ℕ) (R : ℚ) : (left (ell := ell) (H := H) base R).card + (right (H := H) base q R).card ≤ H * (ell * 2 ^ ell + Fintype.card C) := by classical have hi : (leftIndices ell).card ≤ ell * 2 ^ ell := by calc _ ≤ (Finset.univ : Finset (Finset (Fin ell) × Fin ell)).card := Finset.card_filter_le _ _ _ = ell * 2 ^ ell := by simp [Nat.mul_comm] have ha : (left (ell := ell) (H := H) base R).card ≤ H * (ell * 2 ^ ell) := by calc _ ≤ ((Finset.univ : Finset (Fin H)).product (leftIndices ell)).card := Finset.card_image_le _ = H * (leftIndices ell).card := by simp _ ≤ H * (ell * 2 ^ ell) := Nat.mul_le_mul_left H hi have hb : (right (H := H) base q R).card ≤ H * Fintype.card C := by calc _ ≤ (Finset.univ : Finset (Fin H × C)).card := Finset.card_image_le _ = H * Fintype.card C := by simp calc _ ≤ H * (ell * 2 ^ ell) + H * Fintype.card C := Nat.add_le_add ha hb _ = _ := by ring /-- A rectangular chunk construction packages actual controls and all their scalar incidences. No original pin is removed or represented by a control. -/ theorem exists_rectangular {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → Fin ell → ℕ) (hinj : Function.Injective (fun a : C × Fin ell => base a.1 + a.2.val)) (hq : ∀ c i, q c i ≤ H) : ∃ A B : Finset ℚ, Disjoint A B ∧ (∀ x ∈ A, ∀ y ∈ A, ∀ d i, x + y ≠ base d + (i : Fin ell).val) ∧ (∀ x ∈ B, ∀ y ∈ B, ∀ d i, x + y ≠ base d + (i : Fin ell).val) ∧ (∀ d i, (pairs A B (base d + (i : Fin ell).val)).card = q d i) ∧ A.card + B.card ≤ H * (ell * 2 ^ ell + Fintype.card C) := by refine ⟨left (ell := ell) (H := H) base 0, right (H := H) base q 0, controls_disjoint base q 0, ?_, ?_, ?_, controls_card_le base q 0⟩ · intro x hx y hy d i exact left_sum_ne base 0 hx hy d i · intro x hx y hy d i exact right_sum_ne base q 0 hx hy d i · intro d i exact pairs_card base q 0 hinj d i (hq d i) /-- An explicit chunk count: one extra zero chunk is harmless when `ell ∣ m`. This is at most twice the usual ceiling for positive `m`. -/ def chunkCount (m ell : ℕ) : ℕ := m / ell + 1 /-- The explicit bound is within a factor two of the ceiling chunk bound for a nonempty block, including blocks shorter than one chunk. -/ theorem chunkCount_le_two_ceiling {m ell : ℕ} (hm : 0 < m) (hell : 0 < ell) : chunkCount m ell ≤ 2 * ((m + ell - 1) / ell) := by have hnum : m ≤ m + ell - 1 := by omega have hdiv : m / ell ≤ (m + ell - 1) / ell := Nat.div_le_div_right hnum have hnum' : ell ≤ m + ell - 1 := by omega have hpos := Nat.div_pos hnum' hell dsimp [chunkCount] omega def chunkBase {B : Type*} (σ : B → ℚ) (m ell : ℕ) (c : B × Fin (chunkCount m ell)) : ℚ := σ c.1 + (ell : ℚ) * c.2.val /-- Last-chunk bits outside `Fin m` are zero, at every unary level. -/ def padded {B : Type*} {m ell : ℕ} (q : B → Fin m → ℕ) (c : B × Fin (chunkCount m ell)) (j : Fin ell) : ℕ := if h : ell * c.2.val + j.val < m then q c.1 ⟨ell * c.2.val + j.val, h⟩ else 0 theorem padded_outside {B : Type*} {m ell : ℕ} (q : B → Fin m → ℕ) (c : B × Fin (chunkCount m ell)) (j : Fin ell) (hj : m ≤ ell * c.2.val + j.val) : padded q c j = 0 := by simp [padded, Nat.not_lt.mpr hj] theorem chunkBase_injective {B : Type*} (σ : B → ℚ) (m ell : ℕ) (hσ : DistinctResidues σ) : Function.Injective (fun a : (B × Fin (chunkCount m ell)) × Fin ell => chunkBase σ m ell a.1 + a.2.val) := by rintro ⟨⟨b, k⟩, j⟩ ⟨⟨c, l⟩, i⟩ heq have he := @chunk_labels_injective B σ ell hσ ((b, k.val), j) ((c, l.val), i) heq have hbc : b = c := congrArg (fun a => a.1.1) he have hkl : k = l := Fin.ext (congrArg (fun a => a.1.2) he) have hji : j = i := congrArg Prod.snd he subst c subst l subst i rfl /-- Partial last chunks are only zero-padded in the correction table. Every original `Fin m` pin retains its prescribed count. The explicit bound differs from the ceiling bound by at most one right control per block/level. -/ theorem exists_finite {B : Type*} [Fintype B] {m ell H : ℕ} (σ : B → ℚ) (hσ : DistinctResidues σ) (hell : 0 < ell) (q : B → Fin m → ℕ) (hq : ∀ b w, q b w ≤ H) : ∃ A D : Finset ℚ, Disjoint A D ∧ (∀ x ∈ A, ∀ y ∈ A, ∀ b (w : Fin m), x + y ≠ σ b + w.val) ∧ (∀ x ∈ D, ∀ y ∈ D, ∀ b (w : Fin m), x + y ≠ σ b + w.val) ∧ (∀ b (w : Fin m), (pairs A D (σ b + w.val)).card = q b w) ∧ A.card + D.card ≤ H * (ell * 2 ^ ell + Fintype.card B * (m / ell + 1)) := by have hpad : ∀ (c : B × Fin (chunkCount m ell)) (j : Fin ell), padded q c j ≤ H := by intro c j dsimp [padded] split · exact hq _ _ · exact Nat.zero_le _ obtain ⟨A, D, hdis, hAA, hDD, hcount, hsize⟩ := exists_rectangular (H := H) (chunkBase σ m ell) (padded (ell := ell) q) (chunkBase_injective σ m ell hσ) hpad have hpin : ∀ b (w : Fin m), ∃ c j, chunkBase σ m ell c + (j : Fin ell).val = σ b + w.val ∧ padded q c j = q b w := by intro b w have hk : w.val / ell < chunkCount m ell := by have hd : w.val / ell ≤ m / ell := Nat.div_le_div_right (Nat.le_of_lt w.isLt) dsimp [chunkCount] omega let c : B × Fin (chunkCount m ell) := (b, ⟨w.val / ell, hk⟩) let j : Fin ell := ⟨w.val % ell, Nat.mod_lt _ hell⟩ have he : ell * c.2.val + j.val = w.val := by exact Nat.div_add_mod w.val ell refine ⟨c, j, ?_, ?_⟩ · have heq : (ell : ℚ) * c.2.val + j.val = w.val := by exact_mod_cast he dsimp [chunkBase, c] dsimp [c] at heq linarith · have hlt : ell * c.2.val + j.val < m := by omega rw [padded, dif_pos hlt] have hw : (⟨ell * c.2.val + j.val, hlt⟩ : Fin m) = w := Fin.ext he rw [hw] refine ⟨A, D, hdis, ?_, ?_, ?_, ?_⟩ · intro x hx y hy b w obtain ⟨c, j, he, _⟩ := hpin b w rw [← he] exact hAA x hx y hy c j · intro x hx y hy b w obtain ⟨c, j, he, _⟩ := hpin b w rw [← he] exact hDD x hx y hy c j · intro b w obtain ⟨c, j, he, hqeq⟩ := hpin b w rw [← he, hcount, hqeq] · rw [Fintype.card_prod, Fintype.card_fin] at hsize exact hsize /-- Integer-valued prescriptions in `[0,H]` use the same actual control sets. -/ theorem exists_finite_int {B : Type*} [Fintype B] {m ell H : ℕ} (σ : B → ℚ) (hσ : DistinctResidues σ) (hell : 0 < ell) (q : B → Fin m → ℤ) (hq0 : ∀ b w, 0 ≤ q b w) (hqH : ∀ b w, q b w ≤ (H : ℤ)) : ∃ A D : Finset ℚ, Disjoint A D ∧ (∀ x ∈ A, ∀ y ∈ A, ∀ b (w : Fin m), x + y ≠ σ b + w.val) ∧ (∀ x ∈ D, ∀ y ∈ D, ∀ b (w : Fin m), x + y ≠ σ b + w.val) ∧ (∀ b (w : Fin m), ((pairs A D (σ b + w.val)).card : ℤ) = q b w) ∧ A.card + D.card ≤ H * (ell * 2 ^ ell + Fintype.card B * (m / ell + 1)) := by have hnat : ∀ b w, (q b w).toNat ≤ H := by intro b w have hh := hqH b w omega obtain ⟨A, D, hd, ha, hb, hc, hs⟩ := exists_finite σ hσ hell (fun b w => (q b w).toNat) hnat refine ⟨A, D, hd, ha, hb, ?_, hs⟩ intro b w rw [hc] exact Int.toNat_of_nonneg (hq0 b w) end UnaryControls end DistanceCounts end end BodyFile056 -- Source: DistanceCounts/RowControls.lean section BodyFile057 /-! Constant-position unary corrections use only the full-pattern left controls. The original pins are unchanged; the restriction applies only to new controls. -/ noncomputable section namespace DistanceCounts namespace RowControls open Dictionary /-- A constant-position mask has only the empty and full patterns. -/ theorem mask_eq {C : Type*} {ell H : ℕ} (q : C → ℕ) (h : Fin H) (c : C) : UnaryControls.mask (fun c (_ : Fin ell) => q c) h c = if h.val < q c then Finset.univ else ∅ := by classical by_cases ha : h.val < q c <;> simp [UnaryControls.mask, ha] /-- Only the full-pattern markers are needed on the left. -/ def left {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (R : ℚ) : Finset ℚ := by classical exact (Finset.univ : Finset (Fin H × Fin ell)).image fun a => leftLabel (UnaryControls.marker base R a.1) (Finset.univ, a.2) /-- All actual right controls are retained, including inactive levels. -/ def right {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → ℕ) (R : ℚ) : Finset ℚ := UnaryControls.right (H := H) base (fun c (_ : Fin ell) => q c) R theorem left_subset {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (R : ℚ) : left (ell := ell) (H := H) base R ⊆ UnaryControls.left (ell := ell) (H := H) base R := by classical intro x hx obtain ⟨⟨h, i⟩, _, rfl⟩ := Finset.mem_image.mp hx exact Finset.mem_image.mpr ⟨(h, (Finset.univ, i)), by simp [leftIndices], rfl⟩ /-- Every surviving full-dictionary pair already uses the restricted left set. -/ theorem pairs_eq_full {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → ℕ) (R : ℚ) (hinj : Function.Injective (fun a : C × Fin ell => base a.1 + a.2.val)) (d : C) (i : Fin ell) : UnaryControls.pairs (left (ell := ell) (H := H) base R) (right (ell := ell) (H := H) base q R) (base d + i.val) = UnaryControls.pairs (UnaryControls.left (ell := ell) (H := H) base R) (UnaryControls.right (H := H) base (fun c (_ : Fin ell) => q c) R) (base d + i.val) := by classical ext p constructor · intro hp obtain ⟨hpAB, hsum⟩ := Finset.mem_filter.mp hp obtain ⟨hpA, hpB⟩ := Finset.mem_product.mp hpAB exact Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨left_subset base R hpA, hpB⟩, hsum⟩ · intro hp have himage := hp rw [UnaryControls.pairs_eq base (fun c (_ : Fin ell) => q c) R hinj d i] at himage obtain ⟨h, hh, rfl⟩ := Finset.mem_image.mp himage have hactive : h.val < q d := (Finset.mem_filter.mp hh).2 have hmask : UnaryControls.mask (fun c (_ : Fin ell) => q c) h d = Finset.univ := by rw [mask_eq, if_pos hactive] obtain ⟨hpAB, hsum⟩ := Finset.mem_filter.mp hp refine Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨?_, (Finset.mem_product.mp hpAB).2⟩, hsum⟩ change leftLabel (UnaryControls.marker base R h) (UnaryControls.mask (fun c (_ : Fin ell) => q c) h d, i) ∈ left base R rw [hmask] exact Finset.mem_image.mpr ⟨(h, i), Finset.mem_univ _, rfl⟩ theorem pairs_card {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → ℕ) (R : ℚ) (hinj : Function.Injective (fun a : C × Fin ell => base a.1 + a.2.val)) (d : C) (i : Fin ell) (hq : q d ≤ H) : (UnaryControls.pairs (left (ell := ell) (H := H) base R) (right (ell := ell) (H := H) base q R) (base d + i.val)).card = q d := by rw [pairs_eq_full base q R hinj d i] exact UnaryControls.pairs_card base (fun c (_ : Fin ell) => q c) R hinj d i hq theorem controls_disjoint {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → ℕ) (R : ℚ) : Disjoint (left (ell := ell) (H := H) base R) (right (ell := ell) (H := H) base q R) := by classical apply Finset.disjoint_left.mpr intro x hx hy exact Finset.disjoint_left.mp (UnaryControls.controls_disjoint base (fun c (_ : Fin ell) => q c) R) (left_subset base R hx) hy theorem left_sum_ne {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (R : ℚ) {x y : ℚ} (hx : x ∈ left (ell := ell) (H := H) base R) (hy : y ∈ left (ell := ell) (H := H) base R) (d : C) (i : Fin ell) : x + y ≠ base d + i.val := UnaryControls.left_sum_ne base R (left_subset base R hx) (left_subset base R hy) d i theorem right_sum_ne {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → ℕ) (R : ℚ) {x y : ℚ} (hx : x ∈ right (ell := ell) (H := H) base q R) (hy : y ∈ right (ell := ell) (H := H) base q R) (d : C) (i : Fin ell) : x + y ≠ base d + i.val := UnaryControls.right_sum_ne base (fun c (_ : Fin ell) => q c) R hx hy d i /-- The far-placement guarantees survive the restriction as well. -/ theorem controls_far {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → ℕ) (R : ℚ) : (∀ x ∈ left (ell := ell) (H := H) base R, |R| + markerBaseBound base ell < x) ∧ (∀ y ∈ right (ell := ell) (H := H) base q R, y < -(|R| + markerBaseBound base ell)) := by have hf := UnaryControls.controls_far (H := H) base (fun c (_ : Fin ell) => q c) R exact ⟨fun x hx => hf.1 x (left_subset base R hx), hf.2⟩ theorem controls_card_le {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → ℕ) (R : ℚ) : (left (ell := ell) (H := H) base R).card + (right (ell := ell) (H := H) base q R).card ≤ H * ell + H * Fintype.card C := by classical have ha : (left (ell := ell) (H := H) base R).card ≤ H * ell := by calc _ ≤ (Finset.univ : Finset (Fin H × Fin ell)).card := Finset.card_image_le _ = H * ell := by simp have hb : (right (ell := ell) (H := H) base q R).card ≤ H * Fintype.card C := by calc _ ≤ (Finset.univ : Finset (Fin H × C)).card := Finset.card_image_le _ = H * Fintype.card C := by simp exact Nat.add_le_add ha hb /-- Constant-position corrections with a linear number of actual controls. -/ theorem exists_constant {C : Type*} [Fintype C] {ell H : ℕ} (base : C → ℚ) (q : C → ℕ) (hinj : Function.Injective (fun a : C × Fin ell => base a.1 + a.2.val)) (hq : ∀ c, q c ≤ H) : ∃ A D : Finset ℚ, Disjoint A D ∧ (∀ u ∈ A, ∀ v ∈ A, ∀ c i, u + v ≠ base c + (i : Fin ell).val) ∧ (∀ u ∈ D, ∀ v ∈ D, ∀ c i, u + v ≠ base c + (i : Fin ell).val) ∧ (∀ c i, (UnaryControls.pairs A D (base c + (i : Fin ell).val)).card = q c) ∧ A.card + D.card ≤ H * ell + H * Fintype.card C := by refine ⟨left (ell := ell) (H := H) base 0, right (ell := ell) (H := H) base q 0, controls_disjoint base q 0, ?_, ?_, ?_, controls_card_le base q 0⟩ · intro u hu v hv c i exact left_sum_ne base 0 hu hv c i · intro u hu v hv c i exact right_sum_ne base q 0 hu hv c i · intro c i exact pairs_card base q 0 hinj c i (hq c) /-- A block-row is the chunk; its positions run in the horizontal direction. -/ def base {B : Type*} (σ : B → ℚ) (L : ℕ) (c : B × Fin L) : ℚ := (σ c.1 + c.2.val) / L /-- The scalar direction is the original direction `(L, 1)` rescaled by `1/L`. -/ def label {B : Type*} {L : ℕ} (σ : B → ℚ) (b : B) (x y : Fin L) : ℚ := (σ b + (L : ℚ) * x.val + y.val) / L theorem base_add_eq_label {B : Type*} {L : ℕ} (σ : B → ℚ) (hL : 0 < L) (b : B) (x y : Fin L) : base σ L (b, y) + x.val = label σ b x y := by have hLq : (L : ℚ) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt hL) dsimp [base, label] apply (eq_div_iff hLq).mpr rw [add_mul, div_mul_cancel₀ _ hLq] ring /-- Distinct residues and quotient/remainder uniqueness separate every pin. -/ theorem base_injective {B : Type*} {L : ℕ} (σ : B → ℚ) (hσ : DistinctResidues σ) (hL : 0 < L) : Function.Injective (fun a : (B × Fin L) × Fin L => base σ L a.1 + a.2.val) := by rintro ⟨⟨b, y⟩, x⟩ ⟨⟨c, z⟩, w⟩ heq have hLq : (L : ℚ) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt hL) have hm := congrArg (fun t : ℚ => t * L) heq change ((σ b + y.val) / L + x.val) * L = ((σ c + z.val) / L + w.val) * L at hm rw [add_mul, add_mul, div_mul_cancel₀ _ hLq, div_mul_cancel₀ _ hLq] at hm have hraw : σ b + (L : ℚ) * x.val + y.val = σ c + (L : ℚ) * w.val + z.val := by nlinarith [hm] have hi := @chunk_labels_injective B σ L hσ ((b, x.val), y) ((c, w.val), z) hraw have hbc : b = c := congrArg (fun a => a.1.1) hi have hxw : x = w := Fin.ext (congrArg (fun a => a.1.2) hi) have hyz : y = z := congrArg Prod.snd hi subst c subst w subst z rfl /-- Independent corrections at every block-row, constant along its positions. All labels are retained, with cost `H * (L + K * L)` for `K` blocks. -/ theorem exists_rows {B : Type*} [Fintype B] {L H : ℕ} (σ : B → ℚ) (q : B → Fin L → ℕ) (hσ : DistinctResidues σ) (hL : 0 < L) (hq : ∀ b y, q b y ≤ H) : ∃ A D : Finset ℚ, Disjoint A D ∧ (∀ u ∈ A, ∀ v ∈ A, ∀ (b : B) (x y : Fin L), u + v ≠ label σ b x y) ∧ (∀ u ∈ D, ∀ v ∈ D, ∀ (b : B) (x y : Fin L), u + v ≠ label σ b x y) ∧ (∀ b x y, (UnaryControls.pairs A D (label σ b x y)).card = q b y) ∧ A.card + D.card ≤ H * (L + Fintype.card B * L) := by obtain ⟨A, D, hAD, hA, hD, hcount, hcard⟩ := exists_constant (H := H) (base σ L) (fun c => q c.1 c.2) (base_injective σ hσ hL) (fun c => hq c.1 c.2) refine ⟨A, D, hAD, ?_, ?_, ?_, ?_⟩ · intro u hu v hv b x y rw [← base_add_eq_label σ hL b x y] exact hA u hu v hv (b, y) x · intro u hu v hv b x y rw [← base_add_eq_label σ hL b x y] exact hD u hu v hv (b, y) x · intro b x y rw [← base_add_eq_label σ hL b x y] exact hcount (b, y) x · simpa [Fintype.card_prod, Nat.mul_add] using hcard theorem row_budget_le {K H L : ℕ} (hK : 1 ≤ K) : H * (L + K * L) ≤ 2 * K * H * L := by have hLK : L ≤ K * L := by simpa using Nat.mul_le_mul_right L hK calc H * (L + K * L) ≤ H * (K * L + K * L) := Nat.mul_le_mul_left H (Nat.add_le_add_right hLK _) _ = 2 * K * H * L := by ring /-- The customary `2*K*H*L` bound for a nonempty collection of blocks. -/ theorem exists_rows_le_two {B : Type*} [Fintype B] {L H : ℕ} (σ : B → ℚ) (q : B → Fin L → ℕ) (hσ : DistinctResidues σ) (hL : 0 < L) (hq : ∀ b y, q b y ≤ H) (hB : 1 ≤ Fintype.card B) : ∃ A D : Finset ℚ, Disjoint A D ∧ (∀ u ∈ A, ∀ v ∈ A, ∀ (b : B) (x y : Fin L), u + v ≠ label σ b x y) ∧ (∀ u ∈ D, ∀ v ∈ D, ∀ (b : B) (x y : Fin L), u + v ≠ label σ b x y) ∧ (∀ b x y, (UnaryControls.pairs A D (label σ b x y)).card = q b y) ∧ A.card + D.card ≤ 2 * Fintype.card B * H * L := by obtain ⟨A, D, hAD, hA, hD, hcount, hcard⟩ := exists_rows σ q hσ hL hq exact ⟨A, D, hAD, hA, hD, hcount, hcard.trans (row_budget_le hB)⟩ end RowControls end DistanceCounts end end BodyFile057 -- Source: DistanceCounts/CorrectionGeometry.lean section BodyFile058 /-! Rational scalar corrections realized by actual Euclidean line extensions. The tangential coordinate is twice the scalar label: a scalar sum `a + d = s` then gives the geometric midpoint equation `2a + 2d = 2s`. -/ noncomputable section namespace DistanceCounts namespace CorrectionGeometry /-- Physical tangential coordinates, rather than unscaled scalar labels. -/ def tangential (a : ℚ) : ℝ := 2 * (a : ℝ) /-- The coordinatewise map from scalar witnesses to geometric midpoint pairs. -/ def tangentialPair (ad : ℚ × ℚ) : ℝ × ℝ := (tangential ad.1, tangential ad.2) theorem tangential_injective : Function.Injective tangential := by intro a b hab have he : (a : ℝ) = (b : ℝ) := by dsimp [tangential] at hab linarith exact_mod_cast he theorem tangentialPair_injective : Function.Injective tangentialPair := by intro a b hab apply Prod.ext · exact tangential_injective (congrArg Prod.fst hab) · exact tangential_injective (congrArg Prod.snd hab) theorem tangential_sum_iff (a d s : ℚ) : tangential a + tangential d = 2 * (s : ℝ) ↔ a + d = s := by constructor · intro he have he' : (a : ℝ) + (d : ℝ) = (s : ℝ) := by dsimp [tangential] at he linarith exact_mod_cast he' · intro he have he' : (a : ℝ) + (d : ℝ) = (s : ℝ) := by exact_mod_cast he dsimp [tangential] linarith theorem tangential_disjoint (A D : Finset ℚ) (hAD : Disjoint A D) : Disjoint (A.image tangential) (D.image tangential) := by classical apply Finset.disjoint_left.mpr intro t htA htD obtain ⟨a, ha, hea⟩ := Finset.mem_image.mp htA obtain ⟨d, hd, hed⟩ := Finset.mem_image.mp htD have had := tangential_injective (hea.trans hed.symm) subst d exact Finset.disjoint_left.mp hAD ha hd /-- This is equality of actual finite pair sets, not only their cardinalities. -/ theorem crossMidpointPairs_eq_image (A D : Finset ℚ) (s : ℚ) : crossMidpointPairs (planePoint (s : ℝ) 0) (A.image tangential) (D.image tangential) = (UnaryControls.pairs A D s).image tangentialPair := by classical ext z constructor · intro hz obtain ⟨hzAD, hsum⟩ := Finset.mem_filter.mp hz obtain ⟨hzA, hzD⟩ := Finset.mem_product.mp hzAD obtain ⟨a, ha, hea⟩ := Finset.mem_image.mp hzA obtain ⟨d, hd, hed⟩ := Finset.mem_image.mp hzD have he : tangential a + tangential d = 2 * (s : ℝ) := by change z.1 + z.2 = 2 * (s : ℝ) at hsum rw [hea, hed] exact hsum refine Finset.mem_image.mpr ⟨(a, d), ?_, ?_⟩ · exact Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨ha, hd⟩, (tangential_sum_iff a d s).mp he⟩ · exact Prod.ext hea hed · intro hz obtain ⟨ad, had, rfl⟩ := Finset.mem_image.mp hz obtain ⟨hadAD, hsum⟩ := Finset.mem_filter.mp had obtain ⟨ha, hd⟩ := Finset.mem_product.mp hadAD apply Finset.mem_filter.mpr refine ⟨Finset.mem_product.mpr ⟨?_, ?_⟩, ?_⟩ · exact Finset.mem_image.mpr ⟨ad.1, ha, rfl⟩ · exact Finset.mem_image.mpr ⟨ad.2, hd, rfl⟩ · change tangential ad.1 + tangential ad.2 = 2 * (s : ℝ) exact (tangential_sum_iff ad.1 ad.2 s).mpr hsum theorem crossMidpointPairs_card (A D : Finset ℚ) (s : ℚ) : (crossMidpointPairs (planePoint (s : ℝ) 0) (A.image tangential) (D.image tangential)).card = (UnaryControls.pairs A D s).card := by classical rw [crossMidpointPairs_eq_image, Finset.card_image_of_injective _ tangentialPair_injective] /-- Extend any finite old configuration, retaining every old point. Indices need not be injective: only their actual projections and scalar incidences matter. Both control sides are realized with factor-two tangential scaling. -/ theorem exists_rational_control_extension {I : Type*} [Fintype I] {v : Point} (hv : v ≠ 0) (X : Finset Point) (p : I → Point) (s : I → ℚ) (hp : ∀ i, p i ∈ X) (hprojection : ∀ i, lineProjection v (p i) = (s i : ℝ)) (A D : Finset ℚ) (hAD : Disjoint A D) (hA : ∀ i, ∀ a ∈ A, ∀ b ∈ A, a ≠ b → a + b ≠ s i) (hD : ∀ i, ∀ a ∈ D, ∀ b ∈ D, a ≠ b → a + b ≠ s i) : ∃ Y : Finset Point, X ⊆ Y ∧ Y.card = X.card + (A.card + D.card) ∧ ∀ i, pinnedCount Y (p i) + (UnaryControls.pairs A D (s i)).card = pinnedCount X (p i) + (A.card + D.card) := by classical let P : Finset Point := Finset.univ.image p have hPX : P ⊆ X := by intro t ht obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp ht exact hp i have hsame : ∀ E : Finset ℚ, (∀ i, ∀ a ∈ E, ∀ b ∈ E, a ≠ b → a + b ≠ s i) → ∀ t ∈ P, ∀ a ∈ E.image tangential, ∀ b ∈ E.image tangential, a ≠ b → a + b ≠ 2 * lineProjection v t := by intro E hE t ht a ha b hb hab he obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp ht obtain ⟨c, hc, rfl⟩ := Finset.mem_image.mp ha obtain ⟨d, hd, rfl⟩ := Finset.mem_image.mp hb have hcd : c ≠ d := fun h => hab (congrArg tangential h) rw [hprojection i] at he exact hE i c hc d hd hcd ((tangential_sum_iff c d (s i)).mp he) obtain ⟨Y, hXY, hcard, hcount⟩ := exists_oblique_line_extension hv P X (A.image tangential) (D.image tangential) hPX (tangential_disjoint A D hAD) (hsame A hA) (hsame D hD) have hAc : (A.image tangential).card = A.card := Finset.card_image_of_injective _ tangential_injective have hDc : (D.image tangential).card = D.card := Finset.card_image_of_injective _ tangential_injective refine ⟨Y, hXY, ?_, ?_⟩ · simpa only [hAc, hDc, Nat.add_assoc] using hcard · intro i have hi := hcount (p i) (Finset.mem_image.mpr ⟨i, Finset.mem_univ _, rfl⟩) rw [hprojection i, crossMidpointPairs_card, hAc, hDc] at hi simpa only [Nat.add_assoc] using hi /-- Arbitrary bounded unary prescriptions, including partial final chunks, with the actual constructor's budget and without deleting any old pin. -/ theorem exists_finite {B : Type*} [Fintype B] {m ell H : ℕ} {v : Point} (hv : v ≠ 0) (X : Finset Point) (p : B → Fin m → Point) (σ : B → ℚ) (hσ : Dictionary.DistinctResidues σ) (hell : 0 < ell) (q : B → Fin m → ℕ) (hq : ∀ b w, q b w ≤ H) (hp : ∀ b w, p b w ∈ X) (hprojection : ∀ b w, lineProjection v (p b w) = ((σ b + w.val : ℚ) : ℝ)) : ∃ (Y : Finset Point) (k : ℕ), X ⊆ Y ∧ Y.card = X.card + k ∧ k ≤ H * (ell * 2 ^ ell + Fintype.card B * (m / ell + 1)) ∧ ∀ b w, pinnedCount Y (p b w) + q b w = pinnedCount X (p b w) + k := by classical obtain ⟨A, D, hAD, hA, hD, hcount, hbudget⟩ := UnaryControls.exists_finite σ hσ hell q hq obtain ⟨Y, hXY, hcard, hcorr⟩ := exists_rational_control_extension hv X (fun i : B × Fin m => p i.1 i.2) (fun i => σ i.1 + i.2.val) (fun i => hp i.1 i.2) (fun i => hprojection i.1 i.2) A D hAD (fun i a ha d hd _ => hA a ha d hd i.1 i.2) (fun i a ha d hd _ => hD a ha d hd i.1 i.2) refine ⟨Y, A.card + D.card, hXY, hcard, hbudget, ?_⟩ intro b w have he := hcorr (b, w) simpa only [hcount] using he /-- Integer prescriptions retain their signed statement, while the common number of genuinely added Euclidean points is a natural number. -/ theorem exists_finite_int {B : Type*} [Fintype B] {m ell H : ℕ} {v : Point} (hv : v ≠ 0) (X : Finset Point) (p : B → Fin m → Point) (σ : B → ℚ) (hσ : Dictionary.DistinctResidues σ) (hell : 0 < ell) (q : B → Fin m → ℤ) (hq0 : ∀ b w, 0 ≤ q b w) (hqH : ∀ b w, q b w ≤ (H : ℤ)) (hp : ∀ b w, p b w ∈ X) (hprojection : ∀ b w, lineProjection v (p b w) = ((σ b + w.val : ℚ) : ℝ)) : ∃ (Y : Finset Point) (k : ℕ), X ⊆ Y ∧ Y.card = X.card + k ∧ k ≤ H * (ell * 2 ^ ell + Fintype.card B * (m / ell + 1)) ∧ ∀ b w, (pinnedCount Y (p b w) : ℤ) + q b w = (pinnedCount X (p b w) : ℤ) + (k : ℤ) := by classical obtain ⟨A, D, hAD, hA, hD, hcount, hbudget⟩ := UnaryControls.exists_finite_int σ hσ hell q hq0 hqH obtain ⟨Y, hXY, hcard, hcorr⟩ := exists_rational_control_extension hv X (fun i : B × Fin m => p i.1 i.2) (fun i => σ i.1 + i.2.val) (fun i => hp i.1 i.2) (fun i => hprojection i.1 i.2) A D hAD (fun i a ha d hd _ => hA a ha d hd i.1 i.2) (fun i a ha d hd _ => hD a ha d hd i.1 i.2) refine ⟨Y, A.card + D.card, hXY, hcard, hbudget, ?_⟩ intro b w have he : (pinnedCount Y (p b w) : ℤ) + ((UnaryControls.pairs A D (σ b + w.val)).card : ℤ) = (pinnedCount X (p b w) : ℤ) + ((A.card + D.card : ℕ) : ℤ) := by exact_mod_cast hcorr (b, w) rw [hcount b w] at he exact he /-- Rowwise corrections on every original block pin. The labels are exactly `(σ b + L*x + y)/L`; a direction such as `(1,1/L)` may be supplied whenever its actual projection satisfies the displayed equality. No count-correction hypothesis or removal of positions is assumed. -/ theorem exists_rows_le_two {B : Type*} [Fintype B] {L H : ℕ} {v : Point} (hv : v ≠ 0) (X : Finset Point) (p : B → Fin L → Fin L → Point) (σ : B → ℚ) (q : B → Fin L → ℕ) (hσ : Dictionary.DistinctResidues σ) (hL : 0 < L) (hq : ∀ b y, q b y ≤ H) (hB : 1 ≤ Fintype.card B) (hp : ∀ b x y, p b x y ∈ X) (hprojection : ∀ b x y, lineProjection v (p b x y) = (RowControls.label σ b x y : ℝ)) : ∃ (Y : Finset Point) (k : ℕ), X ⊆ Y ∧ Y.card = X.card + k ∧ k ≤ 2 * Fintype.card B * H * L ∧ ∀ b x y, pinnedCount Y (p b x y) + q b y = pinnedCount X (p b x y) + k := by classical obtain ⟨A, D, hAD, hA, hD, hcount, hbudget⟩ := RowControls.exists_rows_le_two σ q hσ hL hq hB obtain ⟨Y, hXY, hcard, hcorr⟩ := exists_rational_control_extension hv X (fun i : B × (Fin L × Fin L) => p i.1 i.2.1 i.2.2) (fun i => RowControls.label σ i.1 i.2.1 i.2.2) (fun i => hp i.1 i.2.1 i.2.2) (fun i => hprojection i.1 i.2.1 i.2.2) A D hAD (fun i a ha d hd _ => hA a ha d hd i.1 i.2.1 i.2.2) (fun i a ha d hd _ => hD a ha d hd i.1 i.2.1 i.2.2) refine ⟨Y, A.card + D.card, hXY, hcard, hbudget, ?_⟩ intro b x y have he := hcorr (b, (x, y)) simpa only [hcount] using he end CorrectionGeometry end DistanceCounts end end BodyFile058 -- Source: DistanceCounts/CoarseLabels.lean section BodyFile059 noncomputable section namespace DistanceCounts.CoarseLabels /-- The undoubled skew projection of the two offsets of a canonical block. -/ def sigma {t : ℕ} (L : ℕ) (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (b : Fin t × Fin t) : ℚ := let u := OffsetSeparation.rationalOffset (z (.inl b.1)) (p (.inl b.1)) let v := OffsetSeparation.rationalOffset (z (.inr b.2)) (p (.inr b.2)) (L : ℚ) * (u.1 + v.1) + u.2 + v.2 theorem doubled_sigma {t : ℕ} (L : ℕ) (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (b : Fin t × Fin t) : OffsetSeparation.sigma p z L b.1 b.2 = 2 * sigma L p z b := by simp only [OffsetSeparation.sigma, OffsetSeparation.projectionNumerator, OffsetSeparation.rationalOffset, sigma, Int.cast_add, Int.cast_mul, Int.cast_natCast] ring theorem sigma_eq_half {t : ℕ} (L : ℕ) (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (b : Fin t × Fin t) : sigma L p z b = OffsetSeparation.sigma p z L b.1 b.2 / 2 := by rw [doubled_sigma] ring /-- An integral difference of the undoubled labels gives an integral difference of the doubled labels. Nonzero residues are required for the actual skew. -/ theorem distinctResidues {t : ℕ} (L : ℕ) (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hinert : ∀ i, p i % 4 = 3) (hres : ∀ i, ¬(p i : ℤ) ∣ OffsetSeparation.projectionNumerator L (z i)) : Dictionary.DistinctResidues (sigma L p z) := by intro b c m hm have he : OffsetSeparation.sigma p z L b.1 b.2 = OffsetSeparation.sigma p z L c.1 c.2 + ((2 * m : ℤ) : ℚ) := by rw [doubled_sigma L p z b, doubled_sigma L p z c] push_cast linarith have h := OffsetSeparation.sigma_unique_mod_integer p z L hp hd hinert hres b.1 c.1 b.2 c.2 (2 * m) he exact Prod.ext h.1 h.2 /-- Row-major indexing, valid even for the empty grid. -/ def gridEquiv (L : ℕ) : GridPairs.Grid L ≃ Fin (L ^ 2) := finProdFinEquiv.trans (finCongr (pow_two L).symm) theorem gridEquiv_val (L : ℕ) (w : GridPairs.Grid L) : (gridEquiv L w).val = L * w.1.val + w.2.val := by change w.2.val + L * w.1.val = L * w.1.val + w.2.val omega theorem gridEquiv_symm_val (L : ℕ) (w : Fin (L ^ 2)) : L * ((gridEquiv L).symm w).1.val + ((gridEquiv L).symm w).2.val = w.val := by rw [← gridEquiv_val, Equiv.apply_symm_apply] /-- The very same canonical pins, enumerated by their unary label. -/ def indexedPin {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (b : Fin t × Fin t) (w : Fin (L ^ 2)) : Point := CoarseGrid.pin p z (b, (gridEquiv L).symm w) theorem indexedPin_gridEquiv {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (b : Fin t × Fin t) (w : GridPairs.Grid L) : indexedPin p z b (gridEquiv L w) = CoarseGrid.pin p z (b, w) := by simp only [indexedPin, Equiv.symm_apply_apply] def rowDirection (L : ℕ) : Point := planePoint 1 (1 / (L : ℝ)) def unaryDirection (L : ℕ) : Point := planePoint L 1 theorem rowDirection_ne_zero (L : ℕ) : rowDirection L ≠ 0 := by intro h have he := congrArg (fun v : Point => v 0) h norm_num [rowDirection, planePoint] at he theorem unaryDirection_ne_zero (L : ℕ) : unaryDirection L ≠ 0 := by intro h have he := congrArg (fun v : Point => v 1) h norm_num [unaryDirection, planePoint] at he theorem unary_projection {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (b : Fin t × Fin t) (x y : Fin L) : lineProjection (unaryDirection L) (CoarseGrid.pin p z (b, (x, y))) = ((sigma L p z b + (L : ℚ) * x.val + y.val : ℚ) : ℝ) := by simp only [lineProjection, unaryDirection, CoarseGrid.pin, CoarseGrid.embed, planePoint_zero, planePoint_one, CoarseGrid.rationalPin, Prod.fst_add, Prod.snd_add, OffsetSeparation.integerVector, sigma] push_cast ring theorem row_projection {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hL : 0 < L) (b : Fin t × Fin t) (x y : Fin L) : lineProjection (rowDirection L) (CoarseGrid.pin p z (b, (x, y))) = (RowControls.label (sigma L p z) b x y : ℝ) := by have hLr : (L : ℝ) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt hL) calc _ = lineProjection (unaryDirection L) (CoarseGrid.pin p z (b, (x, y))) / L := by simp only [lineProjection, rowDirection, unaryDirection, planePoint_zero, planePoint_one] field_simp [hLr] <;> ring _ = _ := by rw [unary_projection] simp only [RowControls.label, Rat.cast_div, Rat.cast_add, Rat.cast_mul, Rat.cast_natCast] theorem indexedPin_projection {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (b : Fin t × Fin t) (w : Fin (L ^ 2)) : lineProjection (unaryDirection L) (indexedPin p z b w) = ((sigma L p z b + w.val : ℚ) : ℝ) := by rw [indexedPin, unary_projection] have he : (L : ℚ) * (((gridEquiv L).symm w).1.val : ℚ) + (((gridEquiv L).symm w).2.val : ℚ) = (w.val : ℚ) := by exact_mod_cast gridEquiv_symm_val L w rw [add_assoc, he] /-- Actual row corrections on all canonical pins in an arbitrary old set. Only the control realization doubles tangential coordinates; the pins and these scalar labels are not doubled. No old point is removed. -/ theorem exists_rows_le_two {t L H : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hinert : ∀ i, p i % 4 = 3) (hres : ∀ i, ¬(p i : ℤ) ∣ OffsetSeparation.projectionNumerator L (z i)) (hL : 0 < L) (X : Finset Point) (hX : CoarseGrid.pins L p z ⊆ X) (q : (Fin t × Fin t) → Fin L → ℕ) (hq : ∀ b y, q b y ≤ H) : ∃ (Y : Finset Point) (k : ℕ), X ⊆ Y ∧ Y.card = X.card + k ∧ k ≤ 2 * t ^ 2 * H * L ∧ ∀ b x y, pinnedCount Y (CoarseGrid.pin p z (b, (x, y))) + q b y = pinnedCount X (CoarseGrid.pin p z (b, (x, y))) + k := by classical by_cases ht : t = 0 · subst t refine ⟨X, 0, Finset.Subset.refl _, by simp, by simp, ?_⟩ intro b exact Fin.elim0 b.1 · have hB : 1 ≤ Fintype.card (Fin t × Fin t) := by simp only [Fintype.card_prod, Fintype.card_fin] have ht' : 1 ≤ t := Nat.one_le_iff_ne_zero.mpr ht exact Nat.mul_le_mul ht' ht' obtain ⟨Y, k, hXY, hcard, hbudget, hcount⟩ := CorrectionGeometry.exists_rows_le_two (rowDirection_ne_zero L) X (fun b x y => CoarseGrid.pin p z (b, (x, y))) (sigma L p z) q (distinctResidues L p z hp hd hinert hres) hL hq hB (fun b x y => hX (CoarseGrid.pin_mem p z (b, (x, y)))) (row_projection p z hL) refine ⟨Y, k, hXY, hcard, ?_, hcount⟩ simpa only [Fintype.card_prod, Fintype.card_fin, pow_two] using hbudget /-- Arbitrary bounded integer prescriptions on every original block and row-major grid index, including zero prescriptions on unselected pins. -/ theorem exists_finite_int {t L ell H : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hinert : ∀ i, p i % 4 = 3) (hres : ∀ i, ¬(p i : ℤ) ∣ OffsetSeparation.projectionNumerator L (z i)) (hell : 0 < ell) (X : Finset Point) (hX : CoarseGrid.pins L p z ⊆ X) (q : (Fin t × Fin t) → Fin (L ^ 2) → ℤ) (hq0 : ∀ b w, 0 ≤ q b w) (hqH : ∀ b w, q b w ≤ (H : ℤ)) : ∃ (Y : Finset Point) (k : ℕ), X ⊆ Y ∧ Y.card = X.card + k ∧ k ≤ H * (ell * 2 ^ ell + t ^ 2 * (L ^ 2 / ell + 1)) ∧ ∀ b w, (pinnedCount Y (indexedPin p z b w) : ℤ) + q b w = (pinnedCount X (indexedPin p z b w) : ℤ) + (k : ℤ) := by classical obtain ⟨Y, k, hXY, hcard, hbudget, hcount⟩ := CorrectionGeometry.exists_finite_int (unaryDirection_ne_zero L) X (indexedPin p z) (sigma L p z) (distinctResidues L p z hp hd hinert hres) hell q hq0 hqH (fun b w => hX (CoarseGrid.pin_mem p z (b, (gridEquiv L).symm w))) (indexedPin_projection p z) refine ⟨Y, k, hXY, hcard, ?_, hcount⟩ simpa only [Fintype.card_prod, Fintype.card_fin, pow_two] using hbudget end DistanceCounts.CoarseLabels end end BodyFile059 -- Source: DistanceCounts/FineIndex.lean section BodyFile060 /-! Finite witness indices inside the unchanged full block/grid index space. -/ noncomputable section namespace DistanceCounts.FineIndex open scoped Classical /-- This only reindexes possible witnesses; it does not modify the ambient configuration. -/ def witnessEquiv {K L : ℕ} (good : Finset (Fin K)) : Fin (good.card * L ^ 2) ≃ good × GridPairs.Grid L := (Fintype.equivFinOfCardEq (by simp only [Fintype.card_prod, Fintype.card_coe, GridPairs.Grid, Fintype.card_fin, pow_two])).symm def ambient {K L : ℕ} (good : Finset (Fin K)) (i : Fin (good.card * L ^ 2)) : Fin K × GridPairs.Grid L := ⟨(witnessEquiv good i).1.val, (witnessEquiv good i).2⟩ theorem ambient_injective {K L : ℕ} (good : Finset (Fin K)) : Function.Injective (ambient (L := L) good) := by intro i j hij apply (witnessEquiv good).injective apply Prod.ext · apply Subtype.ext exact congrArg (fun x : Fin K × GridPairs.Grid L => x.1) hij · exact congrArg (fun x : Fin K × GridPairs.Grid L => x.2) hij theorem ambient_mem {K L : ℕ} (good : Finset (Fin K)) (i : Fin (good.card * L ^ 2)) : (ambient good i).1 ∈ good := (witnessEquiv good i).1.property def group {K L : ℕ} (good : Finset (Fin K)) (i : Fin (good.card * L ^ 2)) : Fin K × Fin L := ⟨(ambient good i).1, (ambient good i).2.2⟩ /-- Extend a correction by zero to all omitted blocks. Original points remain present. -/ def extendCorrection {K L : ℕ} (good : Finset (Fin K)) (q : Fin (good.card * L ^ 2) → ℤ) (b : Fin K) (w : Fin (L ^ 2)) : ℤ := if hb : b ∈ good then q ((witnessEquiv good).symm (⟨b, hb⟩, (CoarseLabels.gridEquiv L).symm w)) else 0 theorem extendCorrection_at {K L : ℕ} (good : Finset (Fin K)) (q : Fin (good.card * L ^ 2) → ℤ) (i : Fin (good.card * L ^ 2)) : extendCorrection good q (ambient good i).1 (CoarseLabels.gridEquiv L (ambient good i).2) = q i := by dsimp only [extendCorrection, ambient] rw [dif_pos (witnessEquiv good i).1.property] simp only [Equiv.symm_apply_apply, Subtype.coe_eta, Prod.mk.eta] theorem extendCorrection_bounds {K L : ℕ} (good : Finset (Fin K)) (q : Fin (good.card * L ^ 2) → ℤ) {H : ℤ} (hH : 0 ≤ H) (hq0 : ∀ i, 0 ≤ q i) (hqH : ∀ i, q i ≤ H) : (∀ b w, 0 ≤ extendCorrection good q b w) ∧ (∀ b w, extendCorrection good q b w ≤ H) := by constructor · intro b w unfold extendCorrection split_ifs <;> first | exact hq0 _ | exact le_rfl · intro b w unfold extendCorrection split_ifs <;> first | exact hqH _ | exact hH theorem card_image_ambient {K L : ℕ} (good : Finset (Fin K)) (S : Finset (Fin (good.card * L ^ 2))) : (S.image (ambient good)).card = S.card := Finset.card_image_of_injective S (ambient_injective good) end DistanceCounts.FineIndex end end BodyFile060 -- Source: DistanceCounts/ProjectionDensity.lean section BodyFile061 /-! Lebesgue interval laws, their convolution density, and finite integer periodization. -/ noncomputable section open Set MeasureTheory open scoped NNReal namespace DistanceCounts.ProjectionDensity /-- Lebesgue density of normalized restricted volume on `[0,a)`, for `a > 0`. -/ def box (a : ℝ) : ℝ → ℝ := (Ico 0 a).indicator (fun _ => 1 / a) /-- The underlying continuous law: scaled restricted Lebesgue measure, not counting measure. -/ def uniformIntervalMeasure (a : ℝ) : Measure ℝ := (ENNReal.ofReal a)⁻¹ • volume.restrict (Ico 0 a) theorem uniformIntervalMeasure_probability {a : ℝ} (ha : 0 < a) : IsProbabilityMeasure (uniformIntervalMeasure a) := by constructor simp [uniformIntervalMeasure, Measure.smul_apply, ha.ne', ENNReal.inv_mul_cancel, ENNReal.ofReal_ne_zero_iff.mpr ha] /-- Integration against the continuous uniform law is integration against `box`. -/ theorem integral_uniformIntervalMeasure {a : ℝ} (ha : 0 < a) (f : ℝ → ℝ) : ∫ x, f x ∂uniformIntervalMeasure a = ∫ x, box a x * f x := by have he : (fun x => box a x * f x) = (Ico 0 a).indicator (fun x => (1 / a) * f x) := by funext x exact (Set.indicator_mul_left (Ico 0 a) (fun _ => 1 / a) f).symm rw [he, integral_indicator measurableSet_Ico, integral_const_mul] simp [uniformIntervalMeasure, integral_smul_measure, ENNReal.toReal_inv, ENNReal.toReal_ofReal ha.le, smul_eq_mul, one_div] /-- The explicit convolution of two interval densities. -/ def density (a b x : ℝ) : ℝ := max 0 (min (min a b) (min x (a + b - x))) / (a * b) theorem measurable_box (a : ℝ) : Measurable (box a) := measurable_const.indicator measurableSet_Ico theorem box_nonneg {a : ℝ} (ha : 0 < a) (x : ℝ) : 0 ≤ box a x := by by_cases hx : x ∈ Ico 0 a <;> simp [box, hx, le_of_lt ha] theorem box_le {a : ℝ} (ha : 0 < a) (x : ℝ) : box a x ≤ 1 / a := by by_cases hx : x ∈ Ico 0 a <;> simp [box, hx, le_of_lt ha] theorem integrable_box (a : ℝ) : Integrable (box a) := by exact (integrableOn_const (by simp : volume (Ico (0 : ℝ) a) ≠ ⊤)).integrable_indicator measurableSet_Ico theorem integral_box {a : ℝ} (ha : 0 < a) : ∫ x, box a x = 1 := by simp [box, integral_indicator_const, Real.volume_real_Ico, max_eq_left ha.le, ha.ne', smul_eq_mul] theorem box_hasCompactSupport (a : ℝ) : HasCompactSupport (box a) := by apply HasCompactSupport.intro (K := Icc 0 a) isCompact_Icc intro x hx apply indicator_of_notMem exact fun h => hx ⟨h.1, h.2.le⟩ /-- Endpoint choices disappear only almost everywhere, not pointwise. -/ theorem box_product_ae (a b x : ℝ) : (fun t => box a t * box b (x - t)) =ᵐ[volume] (Ioo (max 0 (x - b)) (min a x)).indicator (fun _ => 1 / (a * b)) := by have h0 : ∀ᵐ t : ℝ, t ≠ 0 := by apply ae_iff.mpr simp have hx : ∀ᵐ t : ℝ, t ≠ x := by apply ae_iff.mpr simp filter_upwards [h0, hx] with t ht0 htx have hm : (t ∈ Ico 0 a ∧ x - t ∈ Ico 0 b) ↔ t ∈ Ioo (max 0 (x - b)) (min a x) := by simp only [mem_Ico, mem_Ioo, max_lt_iff, lt_min_iff] constructor · rintro ⟨⟨h1, h2⟩, h3, h4⟩ exact ⟨⟨lt_of_le_of_ne h1 (Ne.symm ht0), by linarith⟩, h2, lt_of_le_of_ne (by linarith) htx⟩ · rintro ⟨⟨h1, h2⟩, h3, h4⟩ exact ⟨⟨h1.le, h3⟩, by linarith, by linarith⟩ by_cases h1 : t ∈ Ico 0 a <;> by_cases h2 : x - t ∈ Ico 0 b <;> simp [box, ← hm, h1, h2, one_div, mul_inv, mul_comm] theorem integrable_box_product (a b x : ℝ) : Integrable (fun t => box a t * box b (x - t)) := by have h : Integrable ((Ioo (max 0 (x - b)) (min a x)).indicator (fun _ : ℝ => 1 / (a * b))) := (integrableOn_const (by simp : volume (Ioo (max 0 (x - b)) (min a x)) ≠ ⊤)).integrable_indicator measurableSet_Ioo exact h.congr (box_product_ae a b x).symm theorem overlap_length (a b x : ℝ) : min a x - max 0 (x - b) = min (min a b) (min x (a + b - x)) := by simp only [min_def, max_def] split_ifs <;> linarith theorem density_eq_integral (a b x : ℝ) : density a b x = ∫ t, box a t * box b (x - t) := by rw [integral_congr_ae (box_product_ae a b x), integral_indicator_const, Real.volume_real_Ioo, overlap_length] · simp only [density, smul_eq_mul, div_eq_mul_inv, one_mul, max_comm] · exact measurableSet_Ioo theorem density_eq_convolution (a b : ℝ) : density a b = convolution (box a) (box b) (ContinuousLinearMap.mul ℝ ℝ) volume := by funext x exact density_eq_integral a b x theorem density_eq_integral_swap (a b x : ℝ) : density a b x = ∫ t, box a (x - t) * box b t := by rw [density_eq_convolution] exact convolution_mul_swap theorem integrable_density (a b : ℝ) : Integrable (density a b) := by rw [density_eq_convolution] exact (integrable_box a).integrable_convolution (ContinuousLinearMap.mul ℝ ℝ) (integrable_box b) theorem integral_density {a b : ℝ} (ha : 0 < a) (hb : 0 < b) : ∫ x, density a b x = 1 := by rw [density_eq_convolution, integral_convolution (ContinuousLinearMap.mul ℝ ℝ) (integrable_box a) (integrable_box b), integral_box ha, integral_box hb] simp theorem density_nonneg {a b : ℝ} (ha : 0 < a) (hb : 0 < b) (x : ℝ) : 0 ≤ density a b x := by exact div_nonneg (le_max_left _ _) (mul_pos ha hb).le theorem density_eq_zero_of_notMem (a b x : ℝ) (hx : x ∉ Icc 0 (a + b)) : density a b x = 0 := by have h : min (min a b) (min x (a + b - x)) ≤ 0 := by have h1 := min_le_right (min a b) (min x (a + b - x)) have h2 := min_le_left x (a + b - x) have h3 := min_le_right x (a + b - x) simp only [mem_Icc, not_and_or, not_le] at hx rcases hx with hx | hx <;> linarith simp [density, max_eq_left h] theorem density_hasCompactSupport (a b : ℝ) : HasCompactSupport (density a b) := HasCompactSupport.intro isCompact_Icc (density_eq_zero_of_notMem a b) theorem continuous_density (a b : ℝ) : Continuous (density a b) := by unfold density fun_prop /-- The sharp spatial Lipschitz bound, rather than the also sufficient `2/(a*b)`. -/ theorem density_abs_sub_le {a b : ℝ} (ha : 0 < a) (hb : 0 < b) (x y : ℝ) : |density a b x - density a b y| ≤ |x - y| / (a * b) := by have h1 : |min x (a + b - x) - min y (a + b - y)| ≤ |x - y| := by have he : a + b - x - (a + b - y) = -(x - y) := by ring simpa only [he, abs_neg, max_self] using abs_min_sub_min_le_max x (a + b - x) y (a + b - y) have h2 : |min (min a b) (min x (a + b - x)) - min (min a b) (min y (a + b - y))| ≤ |x - y| := by exact (abs_min_sub_min_le_max _ _ _ _).trans (max_le (by simpa using abs_nonneg (x - y)) h1) have h3 : |max 0 (min (min a b) (min x (a + b - x))) - max 0 (min (min a b) (min y (a + b - y)))| ≤ |x - y| := by exact (abs_max_sub_max_le_max _ _ _ _).trans (max_le (by simpa using abs_nonneg (x - y)) h2) unfold density rw [← sub_div, abs_div, abs_of_pos (mul_pos ha hb)] exact div_le_div_of_nonneg_right h3 (mul_pos ha hb).le theorem lipschitzWith_density {a b : ℝ} (ha : 0 < a) (hb : 0 < b) : LipschitzWith (NNReal.mk (a * b)⁻¹ (by positivity)) (density a b) := by apply lipschitzWith_iff_dist_le_mul.mpr intro x y simpa only [Real.dist_eq, NNReal.coe_mk, div_eq_mul_inv, mul_comm] using density_abs_sub_le ha hb x y /-- Distinct integer translates of an interval of length at most one are disjoint. -/ theorem integer_translate_unique {a s : ℝ} (ha : a ≤ 1) {j k : ℤ} (hj : s - (j : ℝ) ∈ Ico 0 a) (hk : s - (k : ℝ) ∈ Ico 0 a) : j = k := by have hjk : (j : ℝ) < (k : ℝ) + 1 := by have := hj.1 have := hk.2 linarith have hkj : (k : ℝ) < (j : ℝ) + 1 := by have := hk.1 have := hj.2 linarith have h1 : j < k + 1 := by exact_mod_cast hjk have h2 : k < j + 1 := by exact_mod_cast hkj omega theorem sum_box_integer_le {a : ℝ} (ha : 0 < a) (ha1 : a ≤ 1) (D : Finset ℤ) (s : ℝ) : ∑ k ∈ D, box a (s - (k : ℝ)) ≤ 1 / a := by classical by_cases h : ∃ k ∈ D, s - (k : ℝ) ∈ Ico 0 a · obtain ⟨k, hk, hks⟩ := h rw [Finset.sum_eq_single k] · exact box_le ha _ · intro j hj hjk have hjs : s - (j : ℝ) ∉ Ico 0 a := fun hjs => hjk (integer_translate_unique ha1 hjs hks) simp [box, hjs] · exact fun hnot => (hnot hk).elim · have hz : ∀ k ∈ D, box a (s - (k : ℝ)) = 0 := by intro k hk have hks : s - (k : ℝ) ∉ Ico 0 a := fun hks => h ⟨k, hk, hks⟩ simp [box, hks] rw [Finset.sum_eq_zero hz] positivity theorem integrable_box_product_swap {a b : ℝ} (ha : 0 < a) (hb : 0 < b) (x : ℝ) : Integrable (fun t => box a (x - t) * box b t) := by apply ((integrable_box b).const_mul (1 / a)).mono' · exact (((measurable_box a).comp (measurable_const.sub measurable_id)).mul (measurable_box b)).aestronglyMeasurable · filter_upwards with t rw [Real.norm_eq_abs, abs_of_nonneg (mul_nonneg (box_nonneg ha _) (box_nonneg hb _))] exact mul_le_mul_of_nonneg_right (box_le ha _) (box_nonneg hb _) /-- Finite periodization needs no consecutiveness assumption on the integer shifts. -/ theorem sum_density_integer_le {a b : ℝ} (ha : 0 < a) (ha1 : a ≤ 1) (hb : 0 < b) (D : Finset ℤ) (s : ℝ) : ∑ k ∈ D, density a b (s - (k : ℝ)) ≤ 1 / a := by have hi : ∀ k ∈ D, Integrable (fun t => box a (s - (k : ℝ) - t) * box b t) := fun k _ => integrable_box_product_swap ha hb _ calc ∑ k ∈ D, density a b (s - (k : ℝ)) = ∑ k ∈ D, ∫ t, box a (s - (k : ℝ) - t) * box b t := by apply Finset.sum_congr rfl intro k hk exact density_eq_integral_swap a b _ _ = ∫ t, ∑ k ∈ D, box a (s - (k : ℝ) - t) * box b t := (integral_finsetSum D hi).symm _ ≤ ∫ t, (1 / a) * box b t := by apply integral_mono (integrable_finsetSum D hi) ((integrable_box b).const_mul _) intro t dsimp only rw [← Finset.sum_mul] apply mul_le_mul_of_nonneg_right _ (box_nonneg hb t) simpa only [sub_right_comm] using sum_box_integer_le ha ha1 D (s - t) _ = 1 / a := by rw [integral_const_mul, integral_box hb, mul_one] end DistanceCounts.ProjectionDensity end end BodyFile061 -- Source: DistanceCounts/ParameterKernel.lean section BodyFile062 /-! Continuous parameter laws and their averaged pair kernels. No empirical measure or Riemann-sum assertion is made in this file. -/ noncomputable section open Set MeasureTheory Filter open scoped Topology namespace DistanceCounts.ParameterKernel open ProjectionDensity /-- The coordinates are `r ∈ [0,δ)` and `s ∈ [0,1)`, with normalized Lebesgue laws. -/ def parameterMeasure (δ : ℝ) : Measure (ℝ × ℝ) := (uniformIntervalMeasure δ).prod (uniformIntervalMeasure 1) def projection (δ u v : ℝ) (p : ℝ × ℝ) : ℝ := (1 - δ + p.1) * u + (1 + p.2) * v theorem parameterMeasure_probability {δ : ℝ} (hδ : 0 < δ) : IsProbabilityMeasure (parameterMeasure δ) := by letI := uniformIntervalMeasure_probability hδ letI := uniformIntervalMeasure_probability (by norm_num : (0 : ℝ) < 1) unfold parameterMeasure infer_instance /-- The normalized triangular approximate identity. -/ def kernel (h x : ℝ) : ℝ := h⁻¹ * max 0 (1 - |x| / h) theorem kernel_nonneg {h : ℝ} (hh : 0 < h) (x : ℝ) : 0 ≤ kernel h x := by exact mul_nonneg (inv_nonneg.mpr hh.le) (le_max_left _ _) theorem kernel_le {h : ℝ} (hh : 0 < h) (x : ℝ) : kernel h x ≤ h⁻¹ := by unfold kernel calc h⁻¹ * max 0 (1 - |x| / h) ≤ h⁻¹ * 1 := by apply mul_le_mul_of_nonneg_left _ (inv_nonneg.mpr hh.le) exact max_le (by norm_num) (by linarith [div_nonneg (abs_nonneg x) hh.le]) _ = h⁻¹ := mul_one _ theorem kernel_eq_zero {h x : ℝ} (hh : 0 < h) (hx : h ≤ |x|) : kernel h x = 0 := by have : 1 ≤ |x| / h := (le_div_iff₀ hh).mpr (by simpa using hx) simp [kernel, max_eq_left (by linarith : 1 - |x| / h ≤ 0)] theorem continuous_kernel (h : ℝ) : Continuous (kernel h) := by unfold kernel fun_prop theorem kernel_hasCompactSupport {h : ℝ} (hh : 0 < h) : HasCompactSupport (kernel h) := by apply HasCompactSupport.intro (K := Icc (-h) h) isCompact_Icc intro x hx apply kernel_eq_zero hh by_contra hn exact hx (abs_le.mp (le_of_lt (lt_of_not_ge hn))) theorem integrable_kernel {h : ℝ} (hh : 0 < h) : Integrable (kernel h) := (continuous_kernel h).integrable_of_hasCompactSupport (kernel_hasCompactSupport hh) /-- Reuse the already computed convolution, rather than integrate a new tent function. -/ theorem kernel_eq_density {h : ℝ} (hh : 0 < h) (x : ℝ) : kernel h x = density h h (x + h) := by have hm : min (min h h) (min (x + h) (h + h - (x + h))) = h - |x| := by rw [min_self] rcases le_total 0 x with hx | hx · have hi : min (x + h) (h + h - (x + h)) = h + h - (x + h) := min_eq_right (by linarith) have ho : min h (h + h - (x + h)) = h + h - (x + h) := min_eq_right (by linarith) rw [hi, ho, abs_of_nonneg hx] ring · have hi : min (x + h) (h + h - (x + h)) = x + h := min_eq_left (by linarith) have ho : min h (x + h) = x + h := min_eq_right (by linarith) rw [hi, ho, abs_of_nonpos hx] ring unfold kernel density rw [hm] by_cases hx : |x| ≤ h · rw [max_eq_right (by apply sub_nonneg.mpr; exact (div_le_one hh).mpr hx), max_eq_right (sub_nonneg.mpr hx)] field_simp [hh.ne'] <;> ring · have h1 : 1 - |x| / h ≤ 0 := by have : 1 ≤ |x| / h := (le_div_iff₀ hh).mpr (by simpa using le_of_not_ge hx) linarith simp [max_eq_left h1, max_eq_left (by linarith : h - |x| ≤ 0)] theorem integral_kernel {h : ℝ} (hh : 0 < h) : ∫ x, kernel h x = 1 := by simp_rw [kernel_eq_density hh] rw [integral_add_right_eq_self, integral_density hh hh] theorem integral_kernel_translate {h : ℝ} (hh : 0 < h) (z : ℝ) : ∫ x, kernel h (x - z) = 1 := by rw [integral_sub_right_eq_self, integral_kernel hh] /-- Interval-integral version of the continuous uniform law. -/ theorem integral_uniform_eq_interval {a : ℝ} (ha : 0 < a) (f : ℝ → ℝ) : ∫ x, f x ∂uniformIntervalMeasure a = a⁻¹ * ∫ x in (0 : ℝ)..a, f x := by rw [integral_uniformIntervalMeasure ha] have he : (fun x => box a x * f x) = (Ico 0 a).indicator (fun x => a⁻¹ * f x) := by funext x simp [box, Set.indicator, one_div] rw [he, integral_indicator measurableSet_Ico, integral_const_mul, integral_Ico_eq_integral_Ioc, intervalIntegral.integral_of_le ha.le] /-- An affine image of a continuous uniform law, including negative slopes. -/ theorem integral_uniform_affine {a u : ℝ} (ha : 0 < a) (hu : u ≠ 0) (c : ℝ) (f : ℝ → ℝ) : (∫ r, f (c + u * r) ∂uniformIntervalMeasure a) = ∫ x, box (a * |u|) x * f (c + min (a * u) 0 + x) := by have hw : 0 < a * |u| := mul_pos ha (abs_pos.mpr hu) rw [← integral_uniformIntervalMeasure hw, integral_uniform_eq_interval ha, integral_uniform_eq_interval hw, intervalIntegral.integral_comp_add_mul _ hu, intervalIntegral.integral_comp_add_left] simp only [mul_zero, add_zero, smul_eq_mul] rcases lt_or_gt_of_ne hu with hu | hu · rw [abs_of_neg hu, min_eq_left (mul_neg_of_pos_of_neg ha hu).le] have he : c + a * u + a * -u = c := by ring rw [he, intervalIntegral.integral_symm] have he' : c + u * a = c + a * u := by ring rw [he'] field_simp [ha.ne', hu.ne] <;> ring · rw [abs_of_pos hu, min_eq_right (mul_pos ha hu).le] simp only [add_zero] have he : c + u * a = c + a * u := by ring rw [he] field_simp [ha.ne', hu.ne'] <;> ring /-- The lower endpoint of the projection interval. -/ def leftEndpoint (δ u v : ℝ) : ℝ := (1 - δ) * u + v + min (δ * u) 0 + min v 0 /-- The density when neither displacement coordinate vanishes. -/ def pairDensity (δ u v x : ℝ) : ℝ := density (δ * |u|) |v| (x - leftEndpoint δ u v) theorem pairDensity_nonneg {δ u v : ℝ} (hδ : 0 < δ) (hu : u ≠ 0) (hv : v ≠ 0) (x : ℝ) : 0 ≤ pairDensity δ u v x := density_nonneg (mul_pos hδ (abs_pos.mpr hu)) (abs_pos.mpr hv) _ theorem continuous_pairDensity (δ u v : ℝ) : Continuous (pairDensity δ u v) := by exact (continuous_density _ _).comp (continuous_id.sub continuous_const) theorem integrable_pairDensity (δ u v : ℝ) : Integrable (pairDensity δ u v) := (integrable_density _ _).comp_sub_right _ theorem integral_pairDensity {δ u v : ℝ} (hδ : 0 < δ) (hu : u ≠ 0) (hv : v ≠ 0) : ∫ x, pairDensity δ u v x = 1 := by unfold pairDensity rw [integral_sub_right_eq_self] exact integral_density (mul_pos hδ (abs_pos.mpr hu)) (abs_pos.mpr hv) /-- Joint regularity holds on the entire open nondegenerate parameter region. -/ theorem continuousAt_pairDensity {δ u v x : ℝ} (hδ : 0 < δ) (hu : u ≠ 0) (hv : v ≠ 0) : ContinuousAt (fun p : ℝ × ℝ × ℝ × ℝ => pairDensity p.1 p.2.1 p.2.2.1 p.2.2.2) (δ, u, v, x) := by have hden : δ * |u| * |v| ≠ 0 := (mul_pos (mul_pos hδ (abs_pos.mpr hu)) (abs_pos.mpr hv)).ne' unfold pairDensity density leftEndpoint fun_prop (disch := exact hden) /-- A spatial error estimate that is uniform when the two widths are bounded below. -/ theorem pairDensity_abs_sub_le {δ u v : ℝ} (hδ : 0 < δ) (hu : u ≠ 0) (hv : v ≠ 0) (x y : ℝ) : |pairDensity δ u v x - pairDensity δ u v y| ≤ |x - y| / (δ * |u| * |v|) := by unfold pairDensity simpa only [sub_sub_sub_cancel_right] using density_abs_sub_le (mul_pos hδ (abs_pos.mpr hu)) (abs_pos.mpr hv) (x - leftEndpoint δ u v) (y - leftEndpoint δ u v) /-- Fubini and translation identify convolution against every bounded continuous test function. -/ theorem integral_boxes_add (a b c : ℝ) {f : ℝ → ℝ} (hf : Continuous f) {M : ℝ} (hM : ∀ x, ‖f x‖ ≤ M) : (∫ x, box a x * ∫ y, box b y * f (c + x + y)) = ∫ z, density a b (z - c) * f z := by have hi : Integrable (fun p : ℝ × ℝ => box a p.2 * box b (p.1 - p.2) * f (c + p.1)) (volume.prod volume) := by exact ((integrable_box a).convolution_integrand (ContinuousLinearMap.mul ℝ ℝ) (integrable_box b)).mul_bdd (hf.comp (continuous_const.add continuous_fst)).aestronglyMeasurable (Eventually.of_forall fun p => hM _) symm calc (∫ z, density a b (z - c) * f z) = ∫ z, density a b z * f (c + z) := by rw [← integral_add_left_eq_self (f := fun z => density a b (z - c) * f z) c] simp only [add_sub_cancel_left] _ = ∫ z, ∫ t, box a t * box b (z - t) * f (c + z) := by apply integral_congr_ae filter_upwards with z rw [density_eq_integral, integral_mul_const] _ = ∫ t, ∫ z, box a t * box b (z - t) * f (c + z) := integral_integral_swap hi _ = ∫ t, box a t * ∫ y, box b y * f (c + t + y) := by apply integral_congr_ae filter_upwards with t rw [← integral_add_right_eq_self (fun z => box a t * box b (z - t) * f (c + z)) t] simp only [add_sub_cancel_right] rw [← integral_const_mul] congr 1 funext y have he : c + (y + t) = c + t + y := by ring rw [he, mul_assoc] /-- The actual projection law, tested against arbitrary bounded continuous real functions. -/ theorem integral_projection {δ u v : ℝ} (hδ : 0 < δ) (hu : u ≠ 0) (hv : v ≠ 0) {f : ℝ → ℝ} (hf : Continuous f) {M : ℝ} (hM : ∀ x, ‖f x‖ ≤ M) : (∫ p, f (projection δ u v p) ∂parameterMeasure δ) = ∫ x, pairDensity δ u v x * f x := by letI := uniformIntervalMeasure_probability hδ letI := uniformIntervalMeasure_probability (by norm_num : (0 : ℝ) < 1) have hi : Integrable (fun p => f (projection δ u v p)) (parameterMeasure δ) := by letI := parameterMeasure_probability hδ apply Integrable.of_bound (C := M) · exact (hf.comp (by unfold projection; fun_prop)).aestronglyMeasurable · exact Eventually.of_forall fun p => hM _ rw [parameterMeasure, integral_prod _ hi] let c := (1 - δ) * u + v have houter : (∫ r, ∫ s, f (projection δ u v (r, s)) ∂uniformIntervalMeasure 1 ∂uniformIntervalMeasure δ) = ∫ x, box (δ * |u|) x * ∫ s, f (c + (min (δ * u) 0 + x) + v * s) ∂uniformIntervalMeasure 1 := by convert integral_uniform_affine hδ hu 0 (fun t => ∫ s, f (c + t + v * s) ∂uniformIntervalMeasure 1) using 1 · congr 1 funext r congr 1 funext s congr 1 dsimp [projection, c] ring · simp only [zero_add] rw [houter] calc (∫ x, box (δ * |u|) x * ∫ s, f (c + (min (δ * u) 0 + x) + v * s) ∂uniformIntervalMeasure 1) = ∫ x, box (δ * |u|) x * ∫ y, box |v| y * f (leftEndpoint δ u v + x + y) := by apply integral_congr_ae filter_upwards with x rw [integral_uniform_affine (by norm_num : (0 : ℝ) < 1) hv] simp only [one_mul] congr 2 funext y congr 2 dsimp [leftEndpoint, c] ring _ = ∫ x, pairDensity δ u v x * f x := integral_boxes_add _ _ _ hf hM theorem integrable_projection_test {δ : ℝ} (hδ : 0 < δ) (u v : ℝ) {f : ℝ → ℝ} (hf : Continuous f) {M : ℝ} (hM : ∀ x, ‖f x‖ ≤ M) : Integrable (fun p => f (projection δ u v p)) (parameterMeasure δ) := by letI := parameterMeasure_probability hδ exact Integrable.of_bound (hf.comp (by unfold projection; fun_prop)).aestronglyMeasurable M (Eventually.of_forall fun p => hM _) /-- The vertical displacement case has a translated one-dimensional box law. -/ theorem integral_projection_zero_left {δ v : ℝ} (hδ : 0 < δ) (hv : v ≠ 0) {f : ℝ → ℝ} (hf : Continuous f) {M : ℝ} (hM : ∀ x, ‖f x‖ ≤ M) : (∫ p, f (projection δ 0 v p) ∂parameterMeasure δ) = ∫ x, box |v| x * f (v + min v 0 + x) := by letI := uniformIntervalMeasure_probability hδ letI := uniformIntervalMeasure_probability (by norm_num : (0 : ℝ) < 1) rw [parameterMeasure, integral_prod _ (integrable_projection_test hδ 0 v hf hM)] have he (r s : ℝ) : f (projection δ 0 v (r, s)) = f (v + v * s) := by congr 1 dsimp [projection] ring simp_rw [he] rw [integral_const] simp only [Measure.real, measure_univ, ENNReal.toReal_one, one_smul] simpa only [one_mul] using integral_uniform_affine (by norm_num : (0 : ℝ) < 1) hv v f /-- The horizontal displacement case has a box of width `δ*|u|`. -/ theorem integral_projection_zero_right {δ u : ℝ} (hδ : 0 < δ) (hu : u ≠ 0) {f : ℝ → ℝ} (hf : Continuous f) {M : ℝ} (hM : ∀ x, ‖f x‖ ≤ M) : (∫ p, f (projection δ u 0 p) ∂parameterMeasure δ) = ∫ x, box (δ * |u|) x * f ((1 - δ) * u + min (δ * u) 0 + x) := by letI := uniformIntervalMeasure_probability hδ letI := uniformIntervalMeasure_probability (by norm_num : (0 : ℝ) < 1) rw [parameterMeasure, integral_prod _ (integrable_projection_test hδ u 0 hf hM)] have he (r s : ℝ) : f (projection δ u 0 (r, s)) = f ((1 - δ) * u + u * r) := by congr 1 dsimp [projection] ring simp_rw [he, integral_const, Measure.real, measure_univ, ENNReal.toReal_one, one_smul] exact integral_uniform_affine hδ hu _ f theorem integral_uniform_kernel_le {a u h : ℝ} (ha : 0 < a) (hu : u ≠ 0) (hh : 0 < h) (c z : ℝ) : (∫ r, kernel h (c + u * r - z) ∂uniformIntervalMeasure a) ≤ 1 / (a * |u|) := by rw [integral_uniform_affine ha hu c (fun t => kernel h (t - z))] let d := c + min (a * u) 0 - z have he : ∀ x, c + min (a * u) 0 + x - z = d + x := by intro x dsimp [d] ring simp_rw [he] have hw : 0 < a * |u| := mul_pos ha (abs_pos.mpr hu) have hi : Integrable (fun x => box (a * |u|) x * kernel h (d + x)) := (integrable_box _).mul_bdd ((continuous_kernel h).comp (continuous_const.add continuous_id)).aestronglyMeasurable (Eventually.of_forall fun x => by rw [Real.norm_eq_abs, abs_of_nonneg (kernel_nonneg hh _)] exact kernel_le hh _) calc (∫ x, box (a * |u|) x * kernel h (d + x)) ≤ ∫ x, (1 / (a * |u|)) * kernel h (d + x) := integral_mono hi ((integrable_kernel hh).comp_add_left d |>.const_mul _) (fun x => mul_le_mul_of_nonneg_right (box_le hw _) (kernel_nonneg hh _)) _ = 1 / (a * |u|) := by rw [integral_const_mul, integral_add_left_eq_self, integral_kernel hh, mul_one] def averagedKernel (δ u v h z : ℝ) : ℝ := ∫ p, kernel h (projection δ u v p - z) ∂parameterMeasure δ theorem averagedKernel_nonneg {h : ℝ} (hh : 0 < h) (δ u v z : ℝ) : 0 ≤ averagedKernel δ u v h z := integral_nonneg fun p => kernel_nonneg hh _ theorem integrable_parameter_kernel {δ h : ℝ} (hδ : 0 < δ) (hh : 0 < h) (u v z : ℝ) : Integrable (fun p => kernel h (projection δ u v p - z)) (parameterMeasure δ) := integrable_projection_test hδ u v ((continuous_kernel h).comp (continuous_id.sub continuous_const)) (fun x => by change ‖kernel h (x - z)‖ ≤ h⁻¹ rw [Real.norm_eq_abs, abs_of_nonneg (kernel_nonneg hh _)] exact kernel_le hh _) /-- Conditioning on the first coordinate; no hypothesis on the second displacement. -/ theorem averagedKernel_le_left {δ u h : ℝ} (hδ : 0 < δ) (hu : u ≠ 0) (hh : 0 < h) (v z : ℝ) : averagedKernel δ u v h z ≤ 1 / (δ * |u|) := by letI := uniformIntervalMeasure_probability hδ letI := uniformIntervalMeasure_probability (by norm_num : (0 : ℝ) < 1) have hi := integrable_parameter_kernel hδ hh u v z unfold averagedKernel parameterMeasure rw [integral_prod_symm _ hi] calc (∫ s, ∫ r, kernel h (projection δ u v (r, s) - z) ∂uniformIntervalMeasure δ ∂uniformIntervalMeasure 1) ≤ ∫ _ : ℝ, 1 / (δ * |u|) ∂uniformIntervalMeasure 1 := by apply integral_mono hi.integral_prod_right (integrable_const _) intro s change (∫ r, kernel h (projection δ u v (r, s) - z) ∂uniformIntervalMeasure δ) ≤ 1 / (δ * |u|) calc (∫ r, kernel h (projection δ u v (r, s) - z) ∂uniformIntervalMeasure δ) = ∫ r, kernel h ((1 - δ) * u + (1 + s) * v + u * r - z) ∂uniformIntervalMeasure δ := by apply integral_congr_ae filter_upwards with r apply congrArg (kernel h) dsimp [projection] ring _ ≤ 1 / (δ * |u|) := integral_uniform_kernel_le hδ hu hh ((1 - δ) * u + (1 + s) * v) z _ = 1 / (δ * |u|) := by simp /-- Conditioning on the second coordinate; no hypothesis on the first displacement. -/ theorem averagedKernel_le_right {δ v h : ℝ} (hδ : 0 < δ) (hv : v ≠ 0) (hh : 0 < h) (u z : ℝ) : averagedKernel δ u v h z ≤ 1 / |v| := by letI := uniformIntervalMeasure_probability hδ letI := uniformIntervalMeasure_probability (by norm_num : (0 : ℝ) < 1) have hi := integrable_parameter_kernel hδ hh u v z unfold averagedKernel parameterMeasure rw [integral_prod _ hi] calc (∫ r, ∫ s, kernel h (projection δ u v (r, s) - z) ∂uniformIntervalMeasure 1 ∂uniformIntervalMeasure δ) ≤ ∫ _ : ℝ, 1 / |v| ∂uniformIntervalMeasure δ := by apply integral_mono hi.integral_prod_left (integrable_const _) intro r change (∫ s, kernel h (projection δ u v (r, s) - z) ∂uniformIntervalMeasure 1) ≤ 1 / |v| calc (∫ s, kernel h (projection δ u v (r, s) - z) ∂uniformIntervalMeasure 1) = ∫ s, kernel h ((1 - δ + r) * u + v + v * s - z) ∂uniformIntervalMeasure 1 := by apply integral_congr_ae filter_upwards with s apply congrArg (kernel h) dsimp [projection] ring _ ≤ 1 / |v| := by simpa only [one_mul] using integral_uniform_kernel_le (by norm_num : (0 : ℝ) < 1) hv hh ((1 - δ + r) * u + v) z _ = 1 / |v| := by simp /-- Uniform in the bandwidth and in an arbitrary real translation, including axial pairs. -/ theorem averagedKernel_le {δ u v h : ℝ} (hδ : 0 < δ) (huv : u ≠ 0 ∨ v ≠ 0) (hh : 0 < h) (z : ℝ) : averagedKernel δ u v h z ≤ (1 + δ⁻¹) / max |u| |v| := by rcases le_total |u| |v| with hcmp | hcmp · have hv : v ≠ 0 := by intro hv simp only [hv, abs_zero, abs_nonpos_iff] at hcmp exact huv.elim (fun hu => hu hcmp) (fun hv' => hv' hv) rw [max_eq_right hcmp] exact (averagedKernel_le_right hδ hv hh u z).trans (div_le_div_of_nonneg_right (by have := inv_nonneg.mpr hδ.le; linarith) (abs_nonneg v)) · have hu : u ≠ 0 := by intro hu simp only [hu, abs_zero, abs_nonpos_iff] at hcmp exact huv.elim (fun hu' => hu' hu) (fun hv => hv hcmp) rw [max_eq_left hcmp] calc averagedKernel δ u v h z ≤ 1 / (δ * |u|) := averagedKernel_le_left hδ hu hh v z _ = δ⁻¹ / |u| := by simp only [div_eq_mul_inv, mul_inv, one_mul] _ ≤ (1 + δ⁻¹) / |u| := div_le_div_of_nonneg_right (by linarith) (abs_nonneg u) /-- In the non-axial case the parameter average is convolution against the explicit law. -/ theorem averagedKernel_eq_integral {δ u v h : ℝ} (hδ : 0 < δ) (hu : u ≠ 0) (hv : v ≠ 0) (hh : 0 < h) (z : ℝ) : averagedKernel δ u v h z = ∫ x, pairDensity δ u v x * kernel h (x - z) := integral_projection hδ hu hv ((continuous_kernel h).comp (continuous_id.sub continuous_const)) (fun x => by change ‖kernel h (x - z)‖ ≤ h⁻¹ rw [Real.norm_eq_abs, abs_of_nonneg (kernel_nonneg hh _)] exact kernel_le hh _) /-- A quantitative approximate-identity estimate, uniform in the target. -/ theorem averagedKernel_error {δ u v h : ℝ} (hδ : 0 < δ) (hu : u ≠ 0) (hv : v ≠ 0) (hh : 0 < h) (z : ℝ) : |averagedKernel δ u v h z - pairDensity δ u v z| ≤ h / (δ * |u| * |v|) := by have hD : 0 < δ * |u| * |v| := mul_pos (mul_pos hδ (abs_pos.mpr hu)) (abs_pos.mpr hv) have hk : Integrable (fun x => kernel h (x - z)) := (integrable_kernel hh).comp_sub_right z have hp : Integrable (fun x => pairDensity δ u v x * kernel h (x - z)) := (integrable_pairDensity _ _ _).mul_bdd ((continuous_kernel h).comp (continuous_id.sub continuous_const)).aestronglyMeasurable (Eventually.of_forall fun x => by rw [Real.norm_eq_abs, abs_of_nonneg (kernel_nonneg hh _)] exact kernel_le hh _) have he : (∫ x, (pairDensity δ u v x - pairDensity δ u v z) * kernel h (x - z)) = averagedKernel δ u v h z - pairDensity δ u v z := by simp_rw [sub_mul] rw [integral_sub hp (hk.const_mul _), integral_const_mul, integral_kernel_translate hh, mul_one, ← averagedKernel_eq_integral hδ hu hv hh] rw [← he, ← Real.norm_eq_abs] calc ‖∫ x, (pairDensity δ u v x - pairDensity δ u v z) * kernel h (x - z)‖ ≤ ∫ x, (h / (δ * |u| * |v|)) * kernel h (x - z) := by apply norm_integral_le_of_norm_le (hk.const_mul _) filter_upwards with x rw [Real.norm_eq_abs, abs_mul, abs_of_nonneg (kernel_nonneg hh _)] by_cases hx : |x - z| ≤ h · exact mul_le_mul_of_nonneg_right ((pairDensity_abs_sub_le hδ hu hv x z).trans (div_le_div_of_nonneg_right hx hD.le)) (kernel_nonneg hh _) · rw [kernel_eq_zero hh (le_of_not_ge hx)] simp _ = h / (δ * |u| * |v|) := by rw [integral_const_mul, integral_kernel_translate hh, mul_one] /-- Perturbations and smoothing errors are simultaneous, not iterated limits. -/ theorem averagedKernel_perturbed_error {δ u v h : ℝ} (hδ : 0 < δ) (hu : u ≠ 0) (hv : v ≠ 0) (hh : 0 < h) (z e : ℝ) : |averagedKernel δ u v h (z + e) - pairDensity δ u v z| ≤ (h + |e|) / (δ * |u| * |v|) := by calc |averagedKernel δ u v h (z + e) - pairDensity δ u v z| ≤ |averagedKernel δ u v h (z + e) - pairDensity δ u v (z + e)| + |pairDensity δ u v (z + e) - pairDensity δ u v z| := abs_sub_le _ _ _ _ ≤ h / (δ * |u| * |v|) + |e| / (δ * |u| * |v|) := by apply add_le_add (averagedKernel_error hδ hu hv hh _) simpa only [add_sub_cancel_left] using pairDensity_abs_sub_le hδ hu hv (z + e) z _ = (h + |e|) / (δ * |u| * |v|) := (add_div _ _ _).symm /-- Uniform error on every region a positive distance from either coordinate axis. No upper bound on the displacements or target is necessary for this estimate. -/ theorem averagedKernel_uniform_error {δ η u v h : ℝ} (hδ : 0 < δ) (hη : 0 < η) (hu : η ≤ |u|) (hv : η ≤ |v|) (hh : 0 < h) (z e : ℝ) : |averagedKernel δ u v h (z + e) - pairDensity δ u v z| ≤ (h + |e|) / (δ * η * η) := by have hu0 : u ≠ 0 := abs_pos.mp (hη.trans_le hu) have hv0 : v ≠ 0 := abs_pos.mp (hη.trans_le hv) have hD : δ * η * η ≤ δ * |u| * |v| := mul_le_mul (mul_le_mul_of_nonneg_left hu hδ.le) hv hη.le (mul_nonneg hδ.le (abs_nonneg u)) exact (averagedKernel_perturbed_error hδ hu0 hv0 hh z e).trans (div_le_div_of_nonneg_left (add_nonneg hh.le (abs_nonneg e)) (mul_pos (mul_pos hδ hη) hη) hD) /-- Joint limit in bandwidth and translation perturbation for a nondegenerate fixed pair. -/ theorem tendsto_averagedKernel {ι : Type*} {l : Filter ι} {δ u v : ℝ} (hδ : 0 < δ) (hu : u ≠ 0) (hv : v ≠ 0) (z : ℝ) {h e : ι → ℝ} (hh : ∀ᶠ i in l, 0 < h i) (hh0 : Tendsto h l (𝓝 0)) (he0 : Tendsto e l (𝓝 0)) : Tendsto (fun i => averagedKernel δ u v (h i) (z + e i)) l (𝓝 (pairDensity δ u v z)) := by apply tendsto_iff_norm_sub_tendsto_zero.mpr apply squeeze_zero' (Eventually.of_forall fun i => norm_nonneg _) · filter_upwards [hh] with i hi simpa only [Real.norm_eq_abs] using averagedKernel_perturbed_error hδ hu hv hi z (e i) · have habs : Tendsto (fun i => |e i|) l (𝓝 (0 : ℝ)) := by simpa only [abs_zero] using he0.abs simpa only [zero_add, zero_div] using (hh0.add habs).div_const (δ * |u| * |v|) /- The remaining mesoscopic theorem must connect these continuous parameter averages to the empirical pair measures, justify the off-axis Riemann sums, and control the discarded near-diagonal/near-axis pairs. No such empirical convergence or final L² assertion is included among the conclusions above. -/ end DistanceCounts.ParameterKernel end end BodyFile062 -- Source: DistanceCounts/EmpiricalEnergy.lean section BodyFile063 /-! Finite empirical box smoothing with Lebesgue measure. -/ noncomputable section open Set MeasureTheory namespace DistanceCounts.EmpiricalEnergy open ProjectionDensity /-- Translate a half-open box without changing its endpoint convention. -/ theorem box_translate (h a t : ℝ) : box h (t - a) = (Ico a (a + h)).indicator (fun _ => 1 / h) t := by have hm : t - a ∈ Ico 0 h ↔ t ∈ Ico a (a + h) := by simp only [mem_Ico] constructor <;> rintro ⟨h₁, h₂⟩ <;> constructor <;> linarith simp only [box, Set.indicator, hm] /-- Actual interval intersection: no reflection of a half-open interval is used. Thus this identity is even pointwise, and does not identify differing endpoints. -/ theorem box_overlap (h a b t : ℝ) : box h (t - a) * box h (t - b) = (Ico (max a b) (min (a + h) (b + h))).indicator (fun _ => 1 / (h * h)) t := by have hm : (t ∈ Ico a (a + h) ∧ t ∈ Ico b (b + h)) ↔ t ∈ Ico (max a b) (min (a + h) (b + h)) := by simp only [mem_Ico, max_le_iff, lt_min_iff] tauto rw [box_translate, box_translate] by_cases ha : t ∈ Ico a (a + h) <;> by_cases hb : t ∈ Ico b (b + h) <;> simp [Set.indicator, ← hm, ha, hb, one_div, mul_inv] theorem integrable_box_translate (h a : ℝ) : Integrable (fun t => box h (t - a)) := (integrable_box h).comp_sub_right a theorem integral_box_translate {h : ℝ} (hh : 0 < h) (a : ℝ) : ∫ t, box h (t - a) = 1 := by rw [integral_sub_right_eq_self, integral_box hh] theorem integrable_box_overlap (h a b : ℝ) : Integrable (fun t => box h (t - a) * box h (t - b)) := by simp_rw [box_overlap] exact (integrableOn_const (by simp : volume (Ico (max a b) (min (a + h) (b + h))) ≠ ⊤)).integrable_indicator measurableSet_Ico theorem overlap_length (h a b : ℝ) : min (a + h) (b + h) - max a b = h - |a - b| := by rcases le_total a b with hab | hba · rw [min_eq_left (by linarith), max_eq_right hab, abs_of_nonpos (by linarith)] ring · rw [min_eq_right (by linarith), max_eq_left hba, abs_of_nonneg (by linarith)] ring /-- The exact overlap is the existing normalized triangular kernel. -/ theorem integral_box_overlap {h : ℝ} (hh : 0 < h) (a b : ℝ) : (∫ t, box h (t - a) * box h (t - b)) = ParameterKernel.kernel h (a - b) := by simp_rw [box_overlap] rw [integral_indicator_const _ measurableSet_Ico, Real.volume_real_Ico, overlap_length] simp only [smul_eq_mul, ParameterKernel.kernel] by_cases hab : |a - b| ≤ h · rw [max_eq_left (sub_nonneg.mpr hab), max_eq_right (sub_nonneg.mpr ((div_le_one hh).mpr hab))] field_simp [hh.ne'] <;> ring · have h₁ : h - |a - b| ≤ 0 := by linarith have h₂ : 1 - |a - b| / h ≤ 0 := by have := (le_div_iff₀ hh).mpr (show 1 * h ≤ |a - b| by linarith) linarith simp [max_eq_right h₁, max_eq_left h₂] theorem integrable_box_sub_abs (h a b : ℝ) : Integrable (fun t => |box h (t - a) - box h (t - b)|) := ((integrable_box_translate h a).sub (integrable_box_translate h b)).abs /-- The symmetric difference formula uses the actual half-open intervals. -/ theorem box_sub_abs {h : ℝ} (hh : 0 < h) (a b t : ℝ) : |box h (t - a) - box h (t - b)| = box h (t - a) + box h (t - b) - 2 * h * (box h (t - a) * box h (t - b)) := by by_cases ha : t - a ∈ Ico 0 h <;> by_cases hb : t - b ∈ Ico 0 h <;> simp [box, ha, hb, abs_of_pos hh, abs_neg] <;> field_simp [hh.ne'] <;> ring theorem integral_box_sub_abs {h : ℝ} (hh : 0 < h) (a b : ℝ) : (∫ t, |box h (t - a) - box h (t - b)|) = 2 - 2 * h * ParameterKernel.kernel h (a - b) := by simp_rw [box_sub_abs hh] rw [integral_sub (f := fun t : ℝ => box h (t - a) + box h (t - b)) (g := fun t : ℝ => 2 * h * (box h (t - a) * box h (t - b))) ((integrable_box_translate h a).add (integrable_box_translate h b)) ((integrable_box_overlap h a b).const_mul (2 * h)), integral_add (f := fun t : ℝ => box h (t - a)) (g := fun t : ℝ => box h (t - b)) (integrable_box_translate h a) (integrable_box_translate h b), integral_const_mul, integral_box_translate hh, integral_box_translate hh, integral_box_overlap hh] ring theorem integral_box_sub_abs_le {h : ℝ} (hh : 0 < h) (a b : ℝ) : (∫ t, |box h (t - a) - box h (t - b)|) ≤ 2 * |a - b| / h := by rw [integral_box_sub_abs hh] have hk : 1 - h * ParameterKernel.kernel h (a - b) ≤ |a - b| / h := by unfold ParameterKernel.kernel rw [← mul_assoc, mul_inv_cancel₀ hh.ne', one_mul] linarith [le_max_right (0 : ℝ) (1 - |a - b| / h)] calc 2 - 2 * h * ParameterKernel.kernel h (a - b) = 2 * (1 - h * ParameterKernel.kernel h (a - b)) := by ring _ ≤ 2 * (|a - b| / h) := mul_le_mul_of_nonneg_left hk (by norm_num) _ = 2 * |a - b| / h := by ring section Finite variable {I : Type*} [Fintype I] /-- The actual finite empirical density, with one box of mass one per center. -/ def smoothed (z : I → ℝ) (h t : ℝ) : ℝ := (Fintype.card I : ℝ)⁻¹ * ∑ i, box h (t - z i) theorem smoothed_nonneg (z : I → ℝ) {h : ℝ} (hh : 0 < h) (t : ℝ) : 0 ≤ smoothed z h t := by apply mul_nonneg (by positivity) exact Finset.sum_nonneg fun i _ => box_nonneg hh _ theorem integrable_smoothed (z : I → ℝ) (h : ℝ) : Integrable (smoothed z h) := by exact (integrable_finsetSum Finset.univ (fun i _ => integrable_box_translate h (z i))).const_mul _ theorem integral_smoothed [Nonempty I] (z : I → ℝ) {h : ℝ} (hh : 0 < h) : ∫ t, smoothed z h t = 1 := by have hn : (Fintype.card I : ℝ) ≠ 0 := by exact_mod_cast (Fintype.card_pos_iff.mpr (inferInstance : Nonempty I)).ne' unfold smoothed rw [integral_const_mul, integral_finsetSum Finset.univ (fun i _ => integrable_box_translate h (z i))] simp [integral_box_translate hh, hn] /-- Finite expansion, before taking any integral. -/ theorem smoothed_sq (z : I → ℝ) (h t : ℝ) : smoothed z h t ^ 2 = (Fintype.card I : ℝ)⁻¹ ^ 2 * ∑ i, ∑ j, box h (t - z i) * box h (t - z j) := by classical unfold smoothed rw [mul_pow] congr 1 rw [pow_two, Finset.sum_mul_sum] theorem integrable_smoothed_sq (z : I → ℝ) (h : ℝ) : Integrable (fun t => smoothed z h t ^ 2) := by simp_rw [smoothed_sq] exact (integrable_finsetSum Finset.univ (fun i _ => integrable_finsetSum Finset.univ (fun j _ => integrable_box_overlap h (z i) (z j)))).const_mul _ /-- Exact Lebesgue self-energy, including the diagonal pairs. -/ theorem integral_smoothed_sq (z : I → ℝ) {h : ℝ} (hh : 0 < h) : (∫ t, smoothed z h t ^ 2) = (Fintype.card I : ℝ)⁻¹ ^ 2 * ∑ i, ∑ j, ParameterKernel.kernel h (z i - z j) := by simp_rw [smoothed_sq] rw [integral_const_mul, integral_finsetSum Finset.univ (fun i _ => integrable_finsetSum Finset.univ (fun j _ => integrable_box_overlap h (z i) (z j)))] congr 1 apply Finset.sum_congr rfl intro i hi rw [integral_finsetSum Finset.univ (fun j _ => integrable_box_overlap h (z i) (z j))] simp_rw [integral_box_overlap hh] theorem integrable_smoothed_sub_abs (z w : I → ℝ) (h : ℝ) : Integrable (fun t => |smoothed z h t - smoothed w h t|) := ((integrable_smoothed z h).sub (integrable_smoothed w h)).abs /-- A sharper version retaining the mean displacement rather than its maximum. -/ theorem integral_smoothed_sub_abs_le_mean (z w : I → ℝ) {h : ℝ} (hh : 0 < h) : (∫ t, |smoothed z h t - smoothed w h t|) ≤ (Fintype.card I : ℝ)⁻¹ * ∑ i, 2 * |z i - w i| / h := by classical calc (∫ t, |smoothed z h t - smoothed w h t|) ≤ ∫ t, (Fintype.card I : ℝ)⁻¹ * ∑ i, |box h (t - z i) - box h (t - w i)| := by apply integral_mono (integrable_smoothed_sub_abs z w h) ((integrable_finsetSum Finset.univ (fun i _ => integrable_box_sub_abs h (z i) (w i))).const_mul _) intro t simp only [smoothed, ← mul_sub, ← Finset.sum_sub_distrib, abs_mul, abs_of_nonneg (show 0 ≤ (Fintype.card I : ℝ)⁻¹ by positivity)] exact mul_le_mul_of_nonneg_left (Finset.abs_sum_le_sum_abs _ _) (by positivity) _ = (Fintype.card I : ℝ)⁻¹ * ∑ i, ∫ t, |box h (t - z i) - box h (t - w i)| := by rw [integral_const_mul, integral_finsetSum Finset.univ (fun i _ => integrable_box_sub_abs h (z i) (w i))] _ ≤ _ := mul_le_mul_of_nonneg_left (Finset.sum_le_sum fun i _ => integral_box_sub_abs_le hh (z i) (w i)) (by positivity) theorem integral_smoothed_sub_abs_le [Nonempty I] (z w : I → ℝ) {h τ : ℝ} (hh : 0 < h) (hz : ∀ i, |z i - w i| ≤ τ) : (∫ t, |smoothed z h t - smoothed w h t|) ≤ 2 * τ / h := by have hn : (Fintype.card I : ℝ) ≠ 0 := by exact_mod_cast (Fintype.card_pos_iff.mpr (inferInstance : Nonempty I)).ne' calc _ ≤ (Fintype.card I : ℝ)⁻¹ * ∑ i, 2 * |z i - w i| / h := integral_smoothed_sub_abs_le_mean z w hh _ ≤ (Fintype.card I : ℝ)⁻¹ * ∑ _i : I, 2 * τ / h := by apply mul_le_mul_of_nonneg_left _ (by positivity) exact Finset.sum_le_sum fun i _ => div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_left (hz i) (by norm_num)) hh.le _ = _ := by simp [hn, mul_assoc] end Finite /-- Integrability of the actual cross-term; global boundedness of the test is unnecessary. -/ theorem integrable_box_test {f : ℝ → ℝ} (hf : Integrable f) {h : ℝ} (hh : 0 < h) (a : ℝ) : Integrable (fun t => box h (t - a) * f t) := by exact hf.bdd_mul ((measurable_box h).comp (measurable_id.sub measurable_const)).aestronglyMeasurable (Filter.Eventually.of_forall fun t => by rw [Real.norm_eq_abs, abs_of_nonneg (box_nonneg hh _)] exact box_le hh _) /-- Testing a box against a Lipschitz function costs at most its width times the constant. -/ theorem integral_box_test_error {f : ℝ → ℝ} (hf : Integrable f) {K : NNReal} (hLip : LipschitzWith K f) {h : ℝ} (hh : 0 < h) (a : ℝ) : |(∫ t, box h (t - a) * f t) - f a| ≤ (K : ℝ) * h := by have he : (∫ t, box h (t - a) * (f t - f a)) = (∫ t, box h (t - a) * f t) - f a := by simp_rw [mul_sub] rw [integral_sub (f := fun t : ℝ => box h (t - a) * f t) (g := fun t : ℝ => box h (t - a) * f a) (integrable_box_test hf hh a) ((integrable_box_translate h a).mul_const (f a)), integral_mul_const, integral_box_translate hh, one_mul] rw [← he, ← Real.norm_eq_abs] calc ‖∫ t, box h (t - a) * (f t - f a)‖ ≤ ∫ t, box h (t - a) * ((K : ℝ) * h) := by apply norm_integral_le_of_norm_le ((integrable_box_translate h a).mul_const _) filter_upwards with t rw [Real.norm_eq_abs, abs_mul, abs_of_nonneg (box_nonneg hh _)] by_cases ht : t - a ∈ Ico 0 h · apply mul_le_mul_of_nonneg_left _ (box_nonneg hh _) calc |f t - f a| ≤ (K : ℝ) * |t - a| := by simpa only [Real.dist_eq] using hLip.dist_le_mul t a _ ≤ (K : ℝ) * h := mul_le_mul_of_nonneg_left (by rw [abs_of_nonneg ht.1]; exact ht.2.le) K.coe_nonneg · simp [box, ht] _ = (K : ℝ) * h := by rw [integral_mul_const, integral_box_translate hh, one_mul] section FiniteTest variable {I : Type*} [Fintype I] theorem integrable_smoothed_test (z : I → ℝ) {f : ℝ → ℝ} (hf : Integrable f) {h : ℝ} (hh : 0 < h) : Integrable (fun t => smoothed z h t * f t) := by simp only [smoothed, mul_assoc, Finset.sum_mul] exact (integrable_finsetSum Finset.univ (fun i _ => integrable_box_test hf hh (z i))).const_mul _ theorem integral_smoothed_test (z : I → ℝ) {f : ℝ → ℝ} (hf : Integrable f) {h : ℝ} (hh : 0 < h) : (∫ t, smoothed z h t * f t) = (Fintype.card I : ℝ)⁻¹ * ∑ i, ∫ t, box h (t - z i) * f t := by simp only [smoothed, mul_assoc, Finset.sum_mul] rw [integral_const_mul, integral_finsetSum Finset.univ (fun i _ => integrable_box_test hf hh (z i))] /-- The cross-term estimate for the actual finite empirical average. -/ theorem integral_smoothed_test_error [Nonempty I] (z : I → ℝ) {f : ℝ → ℝ} (hf : Integrable f) {K : NNReal} (hLip : LipschitzWith K f) {h : ℝ} (hh : 0 < h) : |(∫ t, smoothed z h t * f t) - (Fintype.card I : ℝ)⁻¹ * ∑ i, f (z i)| ≤ (K : ℝ) * h := by classical have hn : (Fintype.card I : ℝ) ≠ 0 := by exact_mod_cast (Fintype.card_pos_iff.mpr (inferInstance : Nonempty I)).ne' rw [integral_smoothed_test z hf hh, ← mul_sub, ← Finset.sum_sub_distrib, abs_mul, abs_of_nonneg (show 0 ≤ (Fintype.card I : ℝ)⁻¹ by positivity)] calc _ ≤ (Fintype.card I : ℝ)⁻¹ * ∑ i, |(∫ t, box h (t - z i) * f t) - f (z i)| := mul_le_mul_of_nonneg_left (Finset.abs_sum_le_sum_abs _ _) (by positivity) _ ≤ (Fintype.card I : ℝ)⁻¹ * ∑ _i : I, (K : ℝ) * h := mul_le_mul_of_nonneg_left (Finset.sum_le_sum fun i _ => integral_box_test_error hf hLip hh (z i)) (by positivity) _ = _ := by simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] rw [← mul_assoc, inv_mul_cancel₀ hn, one_mul] end FiniteTest end DistanceCounts.EmpiricalEnergy end end BodyFile063 -- Source: DistanceCounts/GridQuadrature.lean section BodyFile064 /-! Continuous cubature of the actual half-open square grid. All distances in this file are product-metric distances, not Euclidean distances on the plane. -/ noncomputable section open Set MeasureTheory Filter Finset open scoped Topology namespace DistanceCounts.GridQuadrature abbrev Point := ℝ × ℝ /-- The actual grid, including the lower and excluding the upper endpoints. -/ def sample (L : ℕ) (p : GridPairs.Grid L) : Point := ((p.1 : ℝ) / L, (p.2 : ℝ) / L) def gridAverage (L : ℕ) (F : Point → ℝ) : ℝ := (∑ p : GridPairs.Grid L, F (sample L p)) / (L : ℝ) ^ 2 /-- Ordered differences are `q - p`; the diagonal pairs are retained. -/ def gridPairAverage (L : ℕ) (F : Point → ℝ) : ℝ := (∑ p : GridPairs.Grid L × GridPairs.Grid L, F (sample L p.2 - sample L p.1)) / (L : ℝ) ^ 4 def unitSquare : Set Point := Set.Icc 0 1 ×ˢ Set.Icc 0 1 def cellCoordinate (L : ℕ) (i : Fin L) (x : ℝ) : ℝ := ((i : ℝ) + x) / L def cell (L : ℕ) (p : GridPairs.Grid L) (x : Point) : Point := (cellCoordinate L p.1 x.1, cellCoordinate L p.2 x.2) def pairCell (L : ℕ) (p : GridPairs.Grid L × GridPairs.Grid L) (x : Point × Point) : Point × Point := (cell L p.1 x.1, cell L p.2 x.2) lemma isCompact_unitSquare : IsCompact unitSquare := isCompact_Icc.prod isCompact_Icc lemma uniform_one_eq_restrict : ProjectionDensity.uniformIntervalMeasure 1 = volume.restrict (Icc (0 : ℝ) 1) := by simp [ProjectionDensity.uniformIntervalMeasure, restrict_Ico_eq_restrict_Icc] lemma parameter_one_eq_restrict : ParameterKernel.parameterMeasure 1 = volume.restrict unitSquare := by rw [ParameterKernel.parameterMeasure, uniform_one_eq_restrict, Measure.prod_restrict] rfl lemma parameter_pair_eq_restrict : (ParameterKernel.parameterMeasure 1).prod (ParameterKernel.parameterMeasure 1) = volume.restrict (unitSquare ×ˢ unitSquare) := by rw [parameter_one_eq_restrict, Measure.prod_restrict] rfl lemma integrable_square {F : Point → ℝ} (hF : Continuous F) : Integrable F (ParameterKernel.parameterMeasure 1) := by rw [parameter_one_eq_restrict] exact hF.continuousOn.integrableOn_compact isCompact_unitSquare lemma integrable_square_pair {G : Point × Point → ℝ} (hG : Continuous G) : Integrable G ((ParameterKernel.parameterMeasure 1).prod (ParameterKernel.parameterMeasure 1)) := by rw [parameter_pair_eq_restrict] exact hG.continuousOn.integrableOn_compact (isCompact_unitSquare.prod isCompact_unitSquare) lemma integrable_difference {F : Point → ℝ} (hF : Continuous F) : Integrable (fun x : Point × Point => F (x.2 - x.1)) ((ParameterKernel.parameterMeasure 1).prod (ParameterKernel.parameterMeasure 1)) := integrable_square_pair (hF.comp (continuous_snd.sub continuous_fst)) /-- A change of variables in each of the `L` adjacent intervals. This is an exact partition identity, not a quadrature hypothesis. -/ lemma coordinate_cells (L : ℕ) (hL : 0 < L) {f : ℝ → ℝ} (hf : Continuous f) : (∫ x in Icc (0 : ℝ) 1, f x) = (∑ i : Fin L, ∫ x in Icc (0 : ℝ) 1, f (cellCoordinate L i x)) / L := by have hLr : (L : ℝ) ≠ 0 := by exact_mod_cast hL.ne' have hi (i : Fin L) : (∫ x in Icc (0 : ℝ) 1, f (cellCoordinate L i x)) = L * ∫ x in (i : ℝ) / L..((i : ℝ) + 1) / L, f x := by rw [integral_Icc_eq_integral_Ioc, ← intervalIntegral.integral_of_le (by norm_num : (0 : ℝ) ≤ 1)] have he : (fun x => f (cellCoordinate L i x)) = (fun x => f (x / L + (i : ℝ) / L)) := by funext x congr 1 simp [cellCoordinate, add_div, add_comm] rw [he, intervalIntegral.integral_comp_div_add f hLr] simp only [zero_div, zero_add, smul_eq_mul] rw [show (1 : ℝ) / L + (i : ℝ) / L = ((i : ℝ) + 1) / L by ring] have hs : (∑ i : Fin L, ∫ x in (i : ℝ) / L..((i : ℝ) + 1) / L, f x) = ∫ x in (0 : ℝ)..1, f x := by rw [Fin.sum_univ_eq_sum_range (fun i : ℕ => ∫ x in (i : ℝ) / L..((i : ℝ) + 1) / L, f x)] have ht := intervalIntegral.sum_integral_adjacent_intervals (a := fun k : ℕ => (k : ℝ) / L) (n := L) (fun k hk => hf.intervalIntegrable (μ := volume) _ _) simpa only [Nat.cast_zero, zero_div, Nat.cast_add, Nat.cast_one, div_self hLr] using ht simp_rw [hi] rw [← Finset.mul_sum, hs, mul_div_cancel_left₀ _ hLr, intervalIntegral.integral_of_le (by norm_num : (0 : ℝ) ≤ 1), integral_Icc_eq_integral_Ioc] section Tensor variable {A B I J : Type*} [MetricSpace A] [MeasureSpace A] [BorelSpace A] [SecondCountableTopology A] [LocallyCompactSpace A] [IsLocallyFiniteMeasure (volume : Measure A)] [SigmaFinite (volume : Measure A)] [MetricSpace B] [MeasureSpace B] [BorelSpace B] [SecondCountableTopology B] [LocallyCompactSpace B] [IsLocallyFiniteMeasure (volume : Measure B)] [SigmaFinite (volume : Measure B)] [Fintype I] [Fintype J] /-- Exact cell decompositions tensorize. Only compactly supported restrictions of Lebesgue measure are used by its applications below. -/ private lemma tensor_cells {s : Set A} {t : Set B} (hs : IsCompact s) (ht : IsCompact t) {a b : ℝ} {c : I → A → A} {d : J → B → B} (hc : ∀ i, Continuous (c i)) (hd : ∀ j, Continuous (d j)) (hca : ∀ f : A → ℝ, Continuous f → (∫ x in s, f x) = (∑ i, ∫ x in s, f (c i x)) / a) (hdb : ∀ f : B → ℝ, Continuous f → (∫ y in t, f y) = (∑ j, ∫ y in t, f (d j y)) / b) {F : A × B → ℝ} (hF : Continuous F) : (∫ z in s ×ˢ t, F z ∂(volume : Measure A).prod (volume : Measure B)) = (∑ p : I × J, ∫ z in s ×ˢ t, F (c p.1 z.1, d p.2 z.2) ∂(volume : Measure A).prod (volume : Measure B)) / (a * b) := by classical have hparam : Continuous (fun x => ∫ y in t, F (x, y)) := continuous_parametric_integral_of_continuous (f := fun (x : A) (y : B) => F (x, y)) (μ := volume) hF ht have hparam' (i : I) (j : J) : Continuous (fun x => ∫ y in t, F (c i x, d j y)) := continuous_parametric_integral_of_continuous (f := fun (x : A) (y : B) => F (c i x, d j y)) (μ := volume) (hF.comp (((hc i).comp continuous_fst).prodMk ((hd j).comp continuous_snd))) ht rw [setIntegral_prod _ (hF.continuousOn.integrableOn_compact (hs.prod ht)), hca _ hparam] have hinner (i : I) : (∫ x in s, ∫ y in t, F (c i x, y)) = (∑ j, ∫ z in s ×ˢ t, F (c i z.1, d j z.2) ∂(volume : Measure A).prod (volume : Measure B)) / b := by have he (x : A) := hdb (fun y => F (c i x, y)) (hF.comp (continuous_const.prodMk continuous_id)) simp_rw [he] rw [integral_div, integral_finsetSum _ (fun j hj => (hparam' i j).continuousOn.integrableOn_compact hs)] congr 1 apply Finset.sum_congr rfl intro j hj symm apply setIntegral_prod exact (hF.comp (((hc i).comp continuous_fst).prodMk ((hd j).comp continuous_snd))).continuousOn.integrableOn_compact (hs.prod ht) simp_rw [hinner] rw [← Finset.sum_div, div_div, mul_comm b a, Fintype.sum_prod_type] end Tensor lemma square_cells (L : ℕ) (hL : 0 < L) {F : Point → ℝ} (hF : Continuous F) : (∫ x, F x ∂ParameterKernel.parameterMeasure 1) = (∑ p : GridPairs.Grid L, ∫ x, F (cell L p x) ∂ParameterKernel.parameterMeasure 1) / (L : ℝ) ^ 2 := by simp_rw [parameter_one_eq_restrict] have hμ : (volume : Measure Point) = (volume : Measure ℝ).prod volume := rfl simpa only [← hμ, unitSquare, cell, pow_two] using tensor_cells isCompact_Icc isCompact_Icc (c := cellCoordinate L) (d := cellCoordinate L) (fun i => by unfold cellCoordinate; fun_prop) (fun i => by unfold cellCoordinate; fun_prop) (fun f hf => coordinate_cells L hL hf) (fun f hf => coordinate_cells L hL hf) hF lemma square_pair_cells (L : ℕ) (hL : 0 < L) {G : Point × Point → ℝ} (hG : Continuous G) : (∫ x, G x ∂(ParameterKernel.parameterMeasure 1).prod (ParameterKernel.parameterMeasure 1)) = (∑ p : GridPairs.Grid L × GridPairs.Grid L, ∫ x, G (pairCell L p x) ∂(ParameterKernel.parameterMeasure 1).prod (ParameterKernel.parameterMeasure 1)) / (L : ℝ) ^ 4 := by have hd (f : Point → ℝ) (hf : Continuous f) := square_cells L hL hf simp_rw [parameter_one_eq_restrict] at hd rw [parameter_pair_eq_restrict] have hp : (L : ℝ) ^ 2 * (L : ℝ) ^ 2 = (L : ℝ) ^ 4 := by ring have hμ : (volume : Measure (Point × Point)) = (volume : Measure Point).prod volume := rfl simpa only [← hμ, pairCell, hp] using tensor_cells isCompact_unitSquare isCompact_unitSquare (c := cell L) (d := cell L) (fun p => by unfold cell cellCoordinate; fun_prop) (fun p => by unfold cell cellCoordinate; fun_prop) hd hd hG lemma cellCoordinate_mem {L : ℕ} (hL : 0 < L) (i : Fin L) {x : ℝ} (hx : x ∈ Icc (0 : ℝ) 1) : cellCoordinate L i x ∈ Icc (0 : ℝ) 1 := by have hLr : (0 : ℝ) < L := by exact_mod_cast hL have hi : (i : ℝ) + 1 ≤ L := by exact_mod_cast (Nat.succ_le_iff.mpr i.isLt) constructor · exact div_nonneg (add_nonneg (by positivity) hx.1) hLr.le · apply (div_le_one hLr).mpr linarith [hx.2] lemma sample_mem {L : ℕ} (hL : 0 < L) (p : GridPairs.Grid L) : sample L p ∈ unitSquare := by have h0 : (0 : ℝ) ∈ Icc (0 : ℝ) 1 := by norm_num simpa [sample, unitSquare, cellCoordinate, and_assoc, and_left_comm, and_comm] using And.intro (cellCoordinate_mem hL p.1 h0) (cellCoordinate_mem hL p.2 h0) lemma cell_mem {L : ℕ} (hL : 0 < L) (p : GridPairs.Grid L) {x : Point} (hx : x ∈ unitSquare) : cell L p x ∈ unitSquare := ⟨cellCoordinate_mem hL p.1 hx.1, cellCoordinate_mem hL p.2 hx.2⟩ lemma cellCoordinate_dist {L : ℕ} (hL : 0 < L) (i : Fin L) {x : ℝ} (hx : x ∈ Icc (0 : ℝ) 1) : dist ((i : ℝ) / L) (cellCoordinate L i x) ≤ (L : ℝ)⁻¹ := by have hLr : (0 : ℝ) < L := by exact_mod_cast hL rw [Real.dist_eq, cellCoordinate, ← sub_div, show (i : ℝ) - (i + x) = -x by ring, abs_div, abs_neg, abs_of_nonneg hx.1, abs_of_pos hLr, inv_eq_one_div] exact div_le_div_of_nonneg_right hx.2 hLr.le /-- The product metric is the maximum of the two coordinate distances. -/ lemma sample_cell_dist {L : ℕ} (hL : 0 < L) (p : GridPairs.Grid L) {x : Point} (hx : x ∈ unitSquare) : dist (sample L p) (cell L p x) ≤ (L : ℝ)⁻¹ := by rw [Prod.dist_eq] exact max_le (cellCoordinate_dist hL p.1 hx.1) (cellCoordinate_dist hL p.2 hx.2) lemma pair_sample_cell_dist {L : ℕ} (hL : 0 < L) (p : GridPairs.Grid L × GridPairs.Grid L) {x : Point × Point} (hx : x ∈ unitSquare ×ˢ unitSquare) : dist (sample L p.1, sample L p.2) (pairCell L p x) ≤ (L : ℝ)⁻¹ := by rw [Prod.dist_eq] exact max_le (sample_cell_dist hL p.1 hx.1) (sample_cell_dist hL p.2 hx.2) section Error variable {X I : Type*} [MeasurableSpace X] [Fintype I] /-- The elementary coupling estimate for a finite exact cell decomposition. -/ private lemma cell_error {μ : Measure X} [IsProbabilityMeasure μ] {f : X → ℝ} {z : I → X} {c : I → X → X} {D E : ℝ} (hD : 0 < D) (hcard : (Fintype.card I : ℝ) = D) (hc : ∀ i, Integrable (fun x => f (c i x)) μ) (hdecomp : (∫ x, f x ∂μ) = (∑ i, ∫ x, f (c i x) ∂μ) / D) (herror : ∀ i, ∀ᵐ x ∂μ, |f (z i) - f (c i x)| ≤ E) : |(∑ i, f (z i)) / D - ∫ x, f x ∂μ| ≤ E := by classical have he (i : I) : |f (z i) - ∫ x, f (c i x) ∂μ| ≤ E := by have hi := norm_integral_le_of_norm_le_const (μ := μ) (f := fun x => f (z i) - f (c i x)) (by simpa only [Real.norm_eq_abs] using herror i) simpa only [integral_sub (integrable_const _) (hc i), integral_const, Measure.real, measure_univ, ENNReal.toReal_one, one_smul, Real.norm_eq_abs, mul_one] using hi rw [hdecomp, ← sub_div, ← Finset.sum_sub_distrib, abs_div, abs_of_pos hD] apply (div_le_iff₀ hD).mpr calc |∑ i, (f (z i) - ∫ x, f (c i x) ∂μ)| ≤ ∑ i, |f (z i) - ∫ x, f (c i x) ∂μ| := Finset.abs_sum_le_sum_abs _ _ _ ≤ ∑ _i : I, E := Finset.sum_le_sum (fun i hi => he i) _ = E * D := by simp [hcard, mul_comm] end Error lemma square_ae_mem : ∀ᵐ x ∂ParameterKernel.parameterMeasure 1, x ∈ unitSquare := by rw [parameter_one_eq_restrict] exact ae_restrict_mem isCompact_unitSquare.measurableSet lemma square_pair_ae_mem : ∀ᵐ x ∂(ParameterKernel.parameterMeasure 1).prod (ParameterKernel.parameterMeasure 1), x ∈ unitSquare ×ˢ unitSquare := by rw [parameter_pair_eq_restrict] exact ae_restrict_mem (isCompact_unitSquare.prod isCompact_unitSquare).measurableSet /-- A modulus-of-continuity error bound; useful also for uniformly controlled families. -/ lemma gridAverage_error (L : ℕ) (hL : 0 < L) {F : Point → ℝ} (hF : Continuous F) {E : ℝ} (hE : ∀ u ∈ unitSquare, ∀ v ∈ unitSquare, dist u v ≤ (L : ℝ)⁻¹ → |F u - F v| ≤ E) : |gridAverage L F - ∫ x, F x ∂ParameterKernel.parameterMeasure 1| ≤ E := by letI := ParameterKernel.parameterMeasure_probability (by norm_num : (0 : ℝ) < 1) apply cell_error (μ := ParameterKernel.parameterMeasure 1) (c := cell L) (z := sample L) (by positivity) (by simp [GridPairs.Grid, Fintype.card_prod, pow_two]) (fun p => integrable_square (hF.comp (by unfold cell cellCoordinate; fun_prop))) (square_cells L hL hF) intro p filter_upwards [square_ae_mem] with x hx exact hE _ (sample_mem hL p) _ (cell_mem hL p hx) (sample_cell_dist hL p hx) lemma gridProduct_error (L : ℕ) (hL : 0 < L) {G : Point × Point → ℝ} (hG : Continuous G) {E : ℝ} (hE : ∀ u ∈ unitSquare ×ˢ unitSquare, ∀ v ∈ unitSquare ×ˢ unitSquare, dist u v ≤ (L : ℝ)⁻¹ → |G u - G v| ≤ E) : |(∑ p : GridPairs.Grid L × GridPairs.Grid L, G (sample L p.1, sample L p.2)) / (L : ℝ) ^ 4 - ∫ x, G x ∂(ParameterKernel.parameterMeasure 1).prod (ParameterKernel.parameterMeasure 1)| ≤ E := by letI := ParameterKernel.parameterMeasure_probability (by norm_num : (0 : ℝ) < 1) apply cell_error (μ := (ParameterKernel.parameterMeasure 1).prod (ParameterKernel.parameterMeasure 1)) (c := pairCell L) (z := fun p => (sample L p.1, sample L p.2)) (by positivity) (by simp [GridPairs.Grid, Fintype.card_prod]; ring) (fun p => integrable_square_pair (hG.comp (by unfold pairCell cell cellCoordinate; fun_prop))) (square_pair_cells L hL hG) intro p filter_upwards [square_pair_ae_mem] with x hx exact hE _ ⟨sample_mem hL p.1, sample_mem hL p.2⟩ _ ⟨cell_mem hL p.1 hx.1, cell_mem hL p.2 hx.2⟩ (pair_sample_cell_dist hL p hx) /-- Continuous test functions on the actual square have their actual finite-grid limit. -/ theorem tendsto_gridAverage {F : Point → ℝ} (hF : Continuous F) : Tendsto (fun L : ℕ => gridAverage L F) atTop (𝓝 (∫ x, F x ∂ParameterKernel.parameterMeasure 1)) := by apply Metric.tendsto_atTop.mpr intro ε hε obtain ⟨δ, hδ, hmod⟩ := Metric.uniformContinuousOn_iff_le.mp (isCompact_unitSquare.uniformContinuousOn_of_continuous hF.continuousOn) (ε / 2) (half_pos hε) have hinv : Tendsto (fun L : ℕ => (L : ℝ)⁻¹) atTop (𝓝 0) := tendsto_inv_atTop_zero.comp tendsto_natCast_atTop_atTop obtain ⟨N, hN⟩ := eventually_atTop.mp (hinv.eventually (gt_mem_nhds hδ)) refine ⟨max N 1, fun L hL => ?_⟩ have hpos : 0 < L := by omega have he := gridAverage_error L hpos hF (E := ε / 2) (fun u hu v hv huv => by simpa only [Real.dist_eq] using hmod u hu v hv (huv.trans (hN L (by omega)).le)) exact lt_of_le_of_lt (by simpa only [Real.dist_eq] using he) (half_lt_self hε) /-- The four-coordinate cubature theorem keeps every ordered pair. -/ theorem tendsto_gridProduct {G : Point × Point → ℝ} (hG : Continuous G) : Tendsto (fun L : ℕ => (∑ p : GridPairs.Grid L × GridPairs.Grid L, G (sample L p.1, sample L p.2)) / (L : ℝ) ^ 4) atTop (𝓝 (∫ x, G x ∂(ParameterKernel.parameterMeasure 1).prod (ParameterKernel.parameterMeasure 1))) := by apply Metric.tendsto_atTop.mpr intro ε hε obtain ⟨δ, hδ, hmod⟩ := Metric.uniformContinuousOn_iff_le.mp ((isCompact_unitSquare.prod isCompact_unitSquare).uniformContinuousOn_of_continuous hG.continuousOn) (ε / 2) (half_pos hε) have hinv : Tendsto (fun L : ℕ => (L : ℝ)⁻¹) atTop (𝓝 0) := tendsto_inv_atTop_zero.comp tendsto_natCast_atTop_atTop obtain ⟨N, hN⟩ := eventually_atTop.mp (hinv.eventually (gt_mem_nhds hδ)) refine ⟨max N 1, fun L hL => ?_⟩ have hpos : 0 < L := by omega have he := gridProduct_error L hpos hG (E := ε / 2) (fun u hu v hv huv => by simpa only [Real.dist_eq] using hmod u hu v hv (huv.trans (hN L (by omega)).le)) exact lt_of_le_of_lt (by simpa only [Real.dist_eq] using he) (half_lt_self hε) /-- In particular the ordered grid differences converge to the double-square law, with orientation `v - u` and with no diagonal removed. -/ theorem tendsto_gridPairAverage {F : Point → ℝ} (hF : Continuous F) : Tendsto (fun L : ℕ => gridPairAverage L F) atTop (𝓝 (∫ u, ∫ v, F (v - u) ∂ParameterKernel.parameterMeasure 1 ∂ParameterKernel.parameterMeasure 1)) := by letI := ParameterKernel.parameterMeasure_probability (by norm_num : (0 : ℝ) < 1) have h := tendsto_gridProduct (hF.comp (continuous_snd.sub continuous_fst)) simp only [Function.comp_def, Pi.sub_apply] at h rw [integral_prod _ (integrable_difference hF)] at h exact h /-- Lipschitz constants refer to the product metric. -/ theorem gridAverage_lipschitz_error (L : ℕ) (hL : 0 < L) {F : Point → ℝ} {K : NNReal} (hF : LipschitzWith K F) : |gridAverage L F - ∫ x, F x ∂ParameterKernel.parameterMeasure 1| ≤ (K : ℝ) / L := by apply gridAverage_error L hL hF.continuous intro u hu v hv huv calc |F u - F v| ≤ (K : ℝ) * dist u v := by simpa only [Real.dist_eq] using hF.dist_le_mul u v _ ≤ (K : ℝ) * (L : ℝ)⁻¹ := mul_le_mul_of_nonneg_left huv K.coe_nonneg _ = (K : ℝ) / L := (div_eq_mul_inv _ _).symm /-- Difference formation has Lipschitz constant two for the nested product metric. -/ theorem gridPairAverage_lipschitz_error (L : ℕ) (hL : 0 < L) {F : Point → ℝ} {K : NNReal} (hF : LipschitzWith K F) : |gridPairAverage L F - ∫ u, ∫ v, F (v - u) ∂ParameterKernel.parameterMeasure 1 ∂ParameterKernel.parameterMeasure 1| ≤ 2 * (K : ℝ) / L := by letI := ParameterKernel.parameterMeasure_probability (by norm_num : (0 : ℝ) < 1) rw [← integral_prod _ (integrable_difference hF.continuous)] apply gridProduct_error L hL (hF.continuous.comp (continuous_snd.sub continuous_fst)) intro u hu v hv huv have h₁ : dist u.1 v.1 ≤ (L : ℝ)⁻¹ := (le_max_left _ _).trans huv have h₂ : dist u.2 v.2 ≤ (L : ℝ)⁻¹ := (le_max_right _ _).trans huv have hd : dist (u.2 - u.1) (v.2 - v.1) ≤ dist u.2 v.2 + dist u.1 v.1 := by simp only [dist_eq_norm] rw [show (u.2 - u.1) - (v.2 - v.1) = (u.2 - v.2) - (u.1 - v.1) by abel] exact norm_sub_le _ _ calc |F (u.2 - u.1) - F (v.2 - v.1)| ≤ (K : ℝ) * dist (u.2 - u.1) (v.2 - v.1) := by simpa only [Real.dist_eq] using hF.dist_le_mul (u.2 - u.1) (v.2 - v.1) _ ≤ (K : ℝ) * (dist u.2 v.2 + dist u.1 v.1) := mul_le_mul_of_nonneg_left hd K.coe_nonneg _ ≤ (K : ℝ) * ((L : ℝ)⁻¹ + (L : ℝ)⁻¹) := mul_le_mul_of_nonneg_left (add_le_add h₂ h₁) K.coe_nonneg _ = 2 * (K : ℝ) / L := by simp only [div_eq_mul_inv]; ring /-- The sample difference has exactly the already-counted integer displacement. -/ lemma sample_sub_eq_displacement (L : ℕ) (p : GridPairs.Grid L × GridPairs.Grid L) : sample L p.2 - sample L p.1 = (((GridPairs.displacement p).1 : ℝ) / L, ((GridPairs.displacement p).2 : ℝ) / L) := by ext <;> simp [sample, GridPairs.displacement, sub_div] end DistanceCounts.GridQuadrature end end BodyFile064 -- Source: DistanceCounts/ProjectionSingularity.lean section BodyFile065 /-! Integrable near-axis domination in displacement coordinates. The product norm below is only an analytic device; pinned distances retain their Euclidean metric. -/ noncomputable section open Set MeasureTheory Filter open scoped Topology namespace DistanceCounts.ProjectionSingularity /-- The displacement square, equipped with actual planar Lebesgue measure. -/ def differenceSquare : Set (ℝ × ℝ) := Icc (-1) 1 ×ˢ Icc (-1) 1 /-- Lean's inverse is zero at the origin; changing this single value does not change any Lebesgue integral. -/ def invRadius (z : ℝ × ℝ) : ℝ := 1 / max |z.1| |z.2| theorem invRadius_eq_inv_norm (z : ℝ × ℝ) : invRadius z = ‖z‖⁻¹ := by simp [invRadius, Prod.norm_def, Real.norm_eq_abs, one_div] theorem invRadius_nonneg (z : ℝ × ℝ) : 0 ≤ invRadius z := by rw [invRadius_eq_inv_norm] exact inv_nonneg.mpr (norm_nonneg z) theorem measurable_invRadius : Measurable invRadius := by have h : invRadius = fun z : ℝ × ℝ => ‖z‖⁻¹ := funext invRadius_eq_inv_norm rw [h] exact measurable_norm.inv /-- The singularity is genuinely locally integrable in dimension two, by the Haar-measure power theorem with exponent one and constant one. -/ theorem locallyIntegrable_invRadius : LocallyIntegrable invRadius := by apply locallyIntegrable_of_norm_le_rpow (C := (1 : ℝ)) (α := (1 : ℝ)) (by simp : 1 ≤ Module.finrank ℝ (ℝ × ℝ)) (by norm_num : (1 : ℝ) < Module.finrank ℝ (ℝ × ℝ)) · exact ae_of_all _ fun z => by rw [Real.norm_eq_abs, abs_of_nonneg (invRadius_nonneg z), invRadius_eq_inv_norm, Real.rpow_neg_one, one_mul] · exact measurable_invRadius.aestronglyMeasurable theorem isCompact_differenceSquare : IsCompact differenceSquare := isCompact_Icc.prod isCompact_Icc theorem measurableSet_differenceSquare : MeasurableSet differenceSquare := isCompact_differenceSquare.measurableSet theorem integrableOn_invRadius : IntegrableOn invRadius differenceSquare := locallyIntegrable_invRadius.integrableOn_isCompact isCompact_differenceSquare /-- The exceptional axes are the actual coordinate axes, not abstract null sets. -/ def axes : Set (ℝ × ℝ) := {z | z.1 = 0 ∨ z.2 = 0} theorem volume_fst_axis : volume {z : ℝ × ℝ | z.1 = 0} = 0 := by have hs : {z : ℝ × ℝ | z.1 = 0} = ({0} : Set ℝ) ×ˢ univ := by ext z simp rw [hs, Measure.volume_eq_prod, Measure.prod_prod] simp theorem volume_snd_axis : volume {z : ℝ × ℝ | z.2 = 0} = 0 := by have hs : {z : ℝ × ℝ | z.2 = 0} = univ ×ˢ ({0} : Set ℝ) := by ext z simp rw [hs, Measure.volume_eq_prod, Measure.prod_prod] simp theorem volume_axes : volume axes = 0 := by change volume ({z : ℝ × ℝ | z.1 = 0} ∪ {z : ℝ × ℝ | z.2 = 0}) = 0 exact measure_union_null volume_fst_axis volume_snd_axis theorem ae_coordinates_ne_zero : ∀ᵐ z : ℝ × ℝ, z.1 ≠ 0 ∧ z.2 ≠ 0 := by have h : ∀ᵐ z : ℝ × ℝ, z ∉ axes := by rw [ae_iff] simpa using volume_axes filter_upwards [h] with z hz simpa [axes, not_or] using hz /-- The union of the two closed coordinate strips of half-width `r`. -/ def nearAxes (r : ℝ) : Set (ℝ × ℝ) := {z | |z.1| ≤ r ∨ |z.2| ≤ r} theorem measurableSet_nearAxes (r : ℝ) : MeasurableSet (nearAxes r) := (measurableSet_le measurable_fst.abs measurable_const).union (measurableSet_le measurable_snd.abs measurable_const) /-- Dominated convergence removes shrinking strips. The two-sided limit is stronger than the positive-radius limit needed in the mesoscopic argument. -/ theorem tendsto_integral_nearAxes : Tendsto (fun r : ℝ => ∫ z in differenceSquare ∩ nearAxes r, invRadius z) (𝓝 0) (𝓝 0) := by have hlim : ∀ᵐ z ∂volume.restrict differenceSquare, Tendsto (fun r : ℝ => (nearAxes r).indicator invRadius z) (𝓝 0) (𝓝 (0 : ℝ)) := by filter_upwards [ae_restrict_of_ae ae_coordinates_ne_zero] with z hz apply tendsto_const_nhds.congr' filter_upwards [eventually_lt_nhds (abs_pos.mpr hz.1), eventually_lt_nhds (abs_pos.mpr hz.2)] with r hu hv simp [nearAxes, not_le.mpr hu, not_le.mpr hv] have h := tendsto_integral_filter_of_dominated_convergence (μ := volume.restrict differenceSquare) (F := fun r : ℝ => (nearAxes r).indicator invRadius) (f := fun _ => (0 : ℝ)) invRadius (Eventually.of_forall fun r => measurable_invRadius.aestronglyMeasurable.indicator (measurableSet_nearAxes r)) (Eventually.of_forall fun r => ae_of_all _ fun z => by calc ‖(nearAxes r).indicator invRadius z‖ ≤ ‖invRadius z‖ := norm_indicator_le_norm_self _ _ _ = invRadius z := Real.norm_of_nonneg (invRadius_nonneg z)) integrableOn_invRadius hlim simpa only [setIntegral_indicator (measurableSet_nearAxes _), integral_zero] using h theorem tendsto_integral_nearAxes_pos : Tendsto (fun r : ℝ => ∫ z in differenceSquare ∩ nearAxes r, invRadius z) (𝓝[>] 0) (𝓝 0) := tendsto_integral_nearAxes.mono_left nhdsWithin_le_nhds /-- One-dimensional continuous transition from zero at `r` to one at `2*r`. -/ def coordinateCutoff (r u : ℝ) : ℝ := min 1 (max 0 ((|u| - r) / r)) /-- The explicit continuous cutoff away from both coordinate axes. -/ def cutoff (r : ℝ) (z : ℝ × ℝ) : ℝ := coordinateCutoff r z.1 * coordinateCutoff r z.2 theorem continuous_coordinateCutoff (r : ℝ) : Continuous (coordinateCutoff r) := by unfold coordinateCutoff fun_prop theorem continuous_cutoff (r : ℝ) : Continuous (cutoff r) := ((continuous_coordinateCutoff r).comp continuous_fst).mul ((continuous_coordinateCutoff r).comp continuous_snd) theorem coordinateCutoff_nonneg (r u : ℝ) : 0 ≤ coordinateCutoff r u := le_min (by norm_num) (le_max_left _ _) theorem coordinateCutoff_le_one (r u : ℝ) : coordinateCutoff r u ≤ 1 := min_le_left _ _ theorem cutoff_nonneg (r : ℝ) (z : ℝ × ℝ) : 0 ≤ cutoff r z := mul_nonneg (coordinateCutoff_nonneg r z.1) (coordinateCutoff_nonneg r z.2) theorem cutoff_le_one (r : ℝ) (z : ℝ × ℝ) : cutoff r z ≤ 1 := mul_le_one₀ (coordinateCutoff_le_one r z.1) (coordinateCutoff_nonneg r z.2) (coordinateCutoff_le_one r z.2) theorem coordinateCutoff_eq_zero {r u : ℝ} (hr : 0 < r) (hu : |u| ≤ r) : coordinateCutoff r u = 0 := by have h : (|u| - r) / r ≤ 0 := div_nonpos_of_nonpos_of_nonneg (sub_nonpos.mpr hu) hr.le simp [coordinateCutoff, max_eq_left h] theorem coordinateCutoff_eq_one {r u : ℝ} (hr : 0 < r) (hu : 2 * r ≤ |u|) : coordinateCutoff r u = 1 := by have h : 1 ≤ (|u| - r) / r := (le_div_iff₀ hr).mpr (by linarith) exact min_eq_left (h.trans (le_max_right _ _)) theorem cutoff_eq_zero {r : ℝ} (hr : 0 < r) {z : ℝ × ℝ} (hz : z ∈ nearAxes r) : cutoff r z = 0 := by rcases hz with hu | hv · simp [cutoff, coordinateCutoff_eq_zero hr hu] · simp [cutoff, coordinateCutoff_eq_zero hr hv] theorem cutoff_eq_one {r : ℝ} (hr : 0 < r) {z : ℝ × ℝ} (hu : 2 * r ≤ |z.1|) (hv : 2 * r ≤ |z.2|) : cutoff r z = 1 := by simp [cutoff, coordinateCutoff_eq_one hr hu, coordinateCutoff_eq_one hr hv] /-- Every nonzero value of the cutoff error lies in the strips of width `2*r`. -/ theorem support_one_sub_cutoff_subset {r : ℝ} (hr : 0 < r) : Function.support (fun z : ℝ × ℝ => 1 - cutoff r z) ⊆ nearAxes (2 * r) := by intro z hz change 1 - cutoff r z ≠ 0 at hz by_contra hn have hu : 2 * r ≤ |z.1| := le_of_lt (lt_of_not_ge (fun h => hn (Or.inl h))) have hv : 2 * r ≤ |z.2| := le_of_lt (lt_of_not_ge (fun h => hn (Or.inr h))) exact hz (by rw [cutoff_eq_one hr hu hv, sub_self]) end DistanceCounts.ProjectionSingularity end end BodyFile065 -- Source: DistanceCounts/EmpiricalPairKernel.lean section BodyFile066 noncomputable section open Set MeasureTheory Filter Finset open scoped Topology namespace DistanceCounts.EmpiricalPairKernel open ParameterKernel GridQuadrature ProjectionSingularity /-- The perturbation is a fixed grid function, not a function of the parameters. -/ def center (L : ℕ) (δ : ℝ) (η : GridPairs.Grid L → ℝ) (a : ℝ × ℝ) (p : GridPairs.Grid L) : ℝ := projection δ (sample L p).1 (sample L p).2 a + η p def pairValue (L : ℕ) (δ h : ℝ) (η : GridPairs.Grid L → ℝ) (p : GridPairs.Grid L × GridPairs.Grid L) : ℝ := averagedKernel δ (sample L p.2 - sample L p.1).1 (sample L p.2 - sample L p.1).2 h (η p.1 - η p.2) /-- The actual parameter average of the normalized ordered pair energy. -/ def energy (L : ℕ) (δ h : ℝ) (η : GridPairs.Grid L → ℝ) : ℝ := ∫ a, (∑ p : GridPairs.Grid L × GridPairs.Grid L, kernel h (center L δ η a p.2 - center L δ η a p.1)) / (L : ℝ)^4 ∂parameterMeasure δ /-- Cutoff is applied to the unperturbed spatial displacement, before averaging. -/ def cutoffEnergy (L : ℕ) (δ h r : ℝ) (η : GridPairs.Grid L → ℝ) : ℝ := ∫ a, (∑ p : GridPairs.Grid L × GridPairs.Grid L, cutoff r (sample L p.2 - sample L p.1) * kernel h (center L δ η a p.2 - center L δ η a p.1)) / (L : ℝ)^4 ∂parameterMeasure δ def cutoffLimit (δ r : ℝ) (d : ℝ × ℝ) : ℝ := cutoff r d * pairDensity δ d.1 d.2 0 lemma center_sub (L : ℕ) (δ : ℝ) (η : GridPairs.Grid L → ℝ) (a : ℝ × ℝ) (p : GridPairs.Grid L × GridPairs.Grid L) : center L δ η a p.2 - center L δ η a p.1 = projection δ (sample L p.2 - sample L p.1).1 (sample L p.2 - sample L p.1).2 a - (η p.1 - η p.2) := by simp only [center, projection, Prod.fst_sub, Prod.snd_sub] ring /-- Every ordered pair, including every diagonal pair, is retained. -/ theorem energy_formula (L : ℕ) {δ h : ℝ} (hδ : 0 < δ) (hh : 0 < h) (η : GridPairs.Grid L → ℝ) : energy L δ h η = (∑ p, pairValue L δ h η p) / (L : ℝ)^4 := by unfold energy simp_rw [center_sub] rw [integral_div, integral_finsetSum _ (fun p hp => integrable_parameter_kernel hδ hh _ _ _)] rfl theorem cutoffEnergy_formula (L : ℕ) {δ h : ℝ} (hδ : 0 < δ) (hh : 0 < h) (r : ℝ) (η : GridPairs.Grid L → ℝ) : cutoffEnergy L δ h r η = (∑ p : GridPairs.Grid L × GridPairs.Grid L, cutoff r (sample L p.2 - sample L p.1) * pairValue L δ h η p) / (L : ℝ)^4 := by unfold cutoffEnergy simp_rw [center_sub] rw [integral_div, integral_finsetSum _ (fun p hp => (integrable_parameter_kernel hδ hh _ _ _).const_mul _)] simp_rw [integral_const_mul] rfl /-- This pair energy is precisely the parameter-averaged empirical Lebesgue L² energy. -/ theorem energy_eq_integral_smoothed_sq (L : ℕ) {δ h : ℝ} (hh : 0 < h) (η : GridPairs.Grid L → ℝ) : energy L δ h η = ∫ a : ℝ × ℝ, (∫ t : ℝ, EmpiricalEnergy.smoothed (center L δ η a) h t ^ 2 ∂volume) ∂parameterMeasure δ := by unfold energy apply integral_congr_ae filter_upwards with a rw [EmpiricalEnergy.integral_smoothed_sq _ hh, Fintype.sum_prod_type] have hs : (∑ p : GridPairs.Grid L, ∑ q : GridPairs.Grid L, kernel h (center L δ η a q - center L δ η a p)) = ∑ p : GridPairs.Grid L, ∑ q : GridPairs.Grid L, kernel h (center L δ η a p - center L δ η a q) := Finset.sum_comm rw [hs] simp only [GridPairs.Grid, Fintype.card_prod, Fintype.card_fin, Nat.cast_mul, div_eq_mul_inv, mul_pow, mul_inv, inv_pow] ring theorem continuous_cutoffLimit {δ r : ℝ} (hδ : 0 < δ) (hr : 0 < r) : Continuous (cutoffLimit δ r) := by apply continuous_iff_continuousAt.mpr intro d by_cases hu : d.1 = 0 · apply (continuousAt_const (y := (0 : ℝ))).congr_of_eventuallyEq have he : ∀ᶠ z : ℝ × ℝ in 𝓝 d, |z.1| < r := (continuous_fst.abs.continuousAt).eventually (gt_mem_nhds (by simpa [hu] using hr)) filter_upwards [he] with z hz simp [cutoffLimit, cutoff_eq_zero hr (Or.inl hz.le)] · by_cases hv : d.2 = 0 · apply (continuousAt_const (y := (0 : ℝ))).congr_of_eventuallyEq have he : ∀ᶠ z : ℝ × ℝ in 𝓝 d, |z.2| < r := (continuous_snd.abs.continuousAt).eventually (gt_mem_nhds (by simpa [hv] using hr)) filter_upwards [he] with z hz simp [cutoffLimit, cutoff_eq_zero hr (Or.inr hz.le)] · have hp := (continuousAt_pairDensity (x := 0) hδ hu hv).comp (f := fun z : ℝ × ℝ => (δ, z.1, z.2, (0 : ℝ))) (show ContinuousAt (fun z : ℝ × ℝ => (δ, z.1, z.2, (0 : ℝ))) d by fun_prop) exact (continuous_cutoff r).continuousAt.mul hp lemma pairValue_nonneg (L : ℕ) (δ : ℝ) {h : ℝ} (hh : 0 < h) (η : GridPairs.Grid L → ℝ) (p : GridPairs.Grid L × GridPairs.Grid L) : 0 ≤ pairValue L δ h η p := averagedKernel_nonneg hh _ _ _ _ lemma perturbation_sub_le {L : ℕ} {η : GridPairs.Grid L → ℝ} {τ : ℝ} (hη : ∀ p, |η p| ≤ τ) (p : GridPairs.Grid L × GridPairs.Grid L) : |η p.1 - η p.2| ≤ 2 * τ := by have ha := abs_sub_le (η p.1) 0 (η p.2) simp only [sub_zero, zero_sub, abs_neg] at ha linarith [hη p.1, hη p.2] /-- Quantitative off-axis estimate with no perturbation hypotheses hidden in a bound. -/ theorem cutoff_pair_error {L : ℕ} {δ h r τ : ℝ} (hδ : 0 < δ) (hh : 0 < h) (hr : 0 < r) (hτ : 0 ≤ τ) {η : GridPairs.Grid L → ℝ} (hη : ∀ p, |η p| ≤ τ) (p : GridPairs.Grid L × GridPairs.Grid L) : |cutoff r (sample L p.2 - sample L p.1) * pairValue L δ h η p - cutoffLimit δ r (sample L p.2 - sample L p.1)| ≤ (h + 2 * τ) / (δ * r^2) := by let d := sample L p.2 - sample L p.1 change |cutoff r d * pairValue L δ h η p - cutoff r d * pairDensity δ d.1 d.2 0| ≤ _ rw [← mul_sub, abs_mul, abs_of_nonneg (cutoff_nonneg r d)] by_cases hz : d ∈ nearAxes r · rw [cutoff_eq_zero hr hz, zero_mul] positivity · have hu : r ≤ |d.1| := le_of_lt (lt_of_not_ge (fun hu => hz (Or.inl hu))) have hv : r ≤ |d.2| := le_of_lt (lt_of_not_ge (fun hv => hz (Or.inr hv))) have he : |pairValue L δ h η p - pairDensity δ d.1 d.2 0| ≤ (h + 2 * τ) / (δ * r^2) := by calc _ ≤ (h + |η p.1 - η p.2|) / (δ * r * r) := by simpa only [pairValue, d, zero_add] using averagedKernel_uniform_error hδ hr hu hv hh 0 (η p.1 - η p.2) _ ≤ (h + 2 * τ) / (δ * r^2) := by rw [pow_two, ← mul_assoc] exact div_le_div_of_nonneg_right (show h + |η p.1 - η p.2| ≤ h + 2 * τ by linarith [perturbation_sub_le hη p]) (by positivity) exact (mul_le_mul_of_nonneg_left he (cutoff_nonneg r d)).trans (mul_le_of_le_one_left (by positivity) (cutoff_le_one r d)) theorem cutoffEnergy_error {L : ℕ} (hL : 0 < L) {δ h r τ : ℝ} (hδ : 0 < δ) (hh : 0 < h) (hr : 0 < r) {η : GridPairs.Grid L → ℝ} (hη : ∀ p, |η p| ≤ τ) : |cutoffEnergy L δ h r η - gridPairAverage L (cutoffLimit δ r)| ≤ (h + 2 * τ) / (δ * r^2) := by have hLr : (0 : ℝ) < L := by exact_mod_cast hL have hτ : 0 ≤ τ := (abs_nonneg _).trans (hη (⟨0, hL⟩, ⟨0, hL⟩)) rw [cutoffEnergy_formula L hδ hh, gridPairAverage, ← sub_div, ← Finset.sum_sub_distrib, abs_div, abs_of_pos (pow_pos hLr 4)] apply (div_le_iff₀ (pow_pos hLr 4)).mpr calc _ ≤ ∑ p : GridPairs.Grid L × GridPairs.Grid L, |cutoff r (sample L p.2 - sample L p.1) * pairValue L δ h η p - cutoffLimit δ r (sample L p.2 - sample L p.1)| := Finset.abs_sum_le_sum_abs _ _ _ ≤ ∑ _p : GridPairs.Grid L × GridPairs.Grid L, (h + 2 * τ) / (δ * r^2) := Finset.sum_le_sum fun p hp => cutoff_pair_error hδ hh hr hτ hη p _ = _ := by simp [GridPairs.Grid, Fintype.card_prod]; ring /-- Closed strips of width `2*r`, on the actual displacement support. -/ def stripDisplacements (L : ℕ) (r : ℝ) : Finset (ℤ × ℤ) := (GridPairs.displacements L).filter (fun d => d ≠ 0 ∧ ((d.1.natAbs : ℝ) / L ≤ 2 * r ∨ (d.2.natAbs : ℝ) / L ≤ 2 * r)) def stripWeight (L : ℕ) (r : ℝ) (d : ℤ × ℤ) : ℝ := if d ≠ 0 ∧ ((d.1.natAbs : ℝ) / L ≤ 2 * r ∨ (d.2.natAbs : ℝ) / L ≤ 2 * r) then (GridPairs.rho L d)⁻¹ else 0 lemma sample_sub_abs {L : ℕ} (hL : 0 < L) (p : GridPairs.Grid L × GridPairs.Grid L) : |(sample L p.2 - sample L p.1).1| = ((GridPairs.displacement p).1.natAbs : ℝ) / L ∧ |(sample L p.2 - sample L p.1).2| = ((GridPairs.displacement p).2.natAbs : ℝ) / L := by have hLr : (0 : ℝ) < L := by exact_mod_cast hL have hc (z : ℤ) : (z.natAbs : ℝ) = |(z : ℝ)| := by simpa only [Int.cast_natCast, Int.cast_abs] using congrArg (fun n : ℤ => (n : ℝ)) (Int.natCast_natAbs z) constructor <;> simp [sample, ← sub_div, abs_div, abs_of_pos hLr, GridPairs.displacement, hc] lemma sample_sub_radius {L : ℕ} (hL : 0 < L) (p : GridPairs.Grid L × GridPairs.Grid L) : max |(sample L p.2 - sample L p.1).1| |(sample L p.2 - sample L p.1).2| = GridPairs.rho L (GridPairs.displacement p) := by rw [(sample_sub_abs hL p).1, (sample_sub_abs hL p).2, max_div_div_right (by positivity)] simp [GridPairs.rho, GridPairs.radius, Nat.cast_max] lemma displacement_eq_zero_iff {L : ℕ} (p : GridPairs.Grid L × GridPairs.Grid L) : GridPairs.displacement p = 0 ↔ p.1 = p.2 := by constructor · intro hp have h₁ : (p.2.1 : ℤ) - (p.1.1 : ℤ) = 0 := congrArg Prod.fst hp have h₂ : (p.2.2 : ℤ) - (p.1.2 : ℤ) = 0 := congrArg Prod.snd hp apply Prod.ext · apply Fin.ext exact (Int.natCast_inj.mp (Int.sub_eq_zero.mp h₁)).symm · apply Fin.ext exact (Int.natCast_inj.mp (Int.sub_eq_zero.mp h₂)).symm · intro hp change ((p.2.1 : ℤ) - p.1.1, (p.2.2 : ℤ) - p.1.2) = 0 rw [hp] exact Prod.ext (Int.sub_self _) (Int.sub_self _) lemma stripWeight_nonneg (L : ℕ) (r : ℝ) (d : ℤ × ℤ) : 0 ≤ stripWeight L r d := by unfold stripWeight GridPairs.rho split_ifs <;> positivity lemma stripWeight_sum (L : ℕ) (r : ℝ) : (∑ p : GridPairs.Grid L × GridPairs.Grid L, stripWeight L r (GridPairs.displacement p)) / (L : ℝ)^4 = GridPairs.kernelSum L (stripDisplacements L r) := by rw [GridPairs.sum_by_displacement] unfold GridPairs.kernelSum stripDisplacements rw [Finset.sum_filter] congr 1 apply Finset.sum_congr rfl intro d hd unfold stripWeight split_ifs <;> simp [div_eq_mul_inv] lemma pairValue_diagonal (L : ℕ) {δ h : ℝ} (hδ : 0 < δ) (η : GridPairs.Grid L → ℝ) (p : GridPairs.Grid L) : pairValue L δ h η (p,p) = h⁻¹ := by letI := parameterMeasure_probability hδ simp [pairValue, averagedKernel, projection, kernel] /-- Pointwise diagonal/strip domination, including axial displacements and arbitrary jitter. -/ lemma pair_remainder_le {L : ℕ} (hL : 0 < L) {δ h r : ℝ} (hδ : 0 < δ) (hh : 0 < h) (hr : 0 < r) (η : GridPairs.Grid L → ℝ) (p : GridPairs.Grid L × GridPairs.Grid L) : (1 - cutoff r (sample L p.2 - sample L p.1)) * pairValue L δ h η p ≤ (if p.1 = p.2 then h⁻¹ else 0) + (1 + δ⁻¹) * stripWeight L r (GridPairs.displacement p) := by have hC : 0 ≤ 1 + δ⁻¹ := by positivity have hK := pairValue_nonneg L δ hh η p by_cases hp : p.1 = p.2 · have he : p = (p.1,p.1) := Prod.ext rfl hp.symm rw [he, pairValue_diagonal L hδ] simp [stripWeight, GridPairs.displacement, cutoff_eq_zero hr (show (0 : ℝ × ℝ) ∈ nearAxes r from Or.inl (by simpa using hr.le))] · rw [if_neg hp, zero_add] by_cases hc : 1 - cutoff r (sample L p.2 - sample L p.1) = 0 · rw [hc, zero_mul] exact mul_nonneg hC (stripWeight_nonneg _ _ _) · have hd : GridPairs.displacement p ≠ 0 := fun hd => hp ((displacement_eq_zero_iff p).mp hd) have hs := support_one_sub_cutoff_subset hr hc have hs' : ((GridPairs.displacement p).1.natAbs : ℝ) / L ≤ 2 * r ∨ ((GridPairs.displacement p).2.natAbs : ℝ) / L ≤ 2 * r := by simpa only [nearAxes, Set.mem_setOf_eq, (sample_sub_abs hL p).1, (sample_sub_abs hL p).2] using hs rw [stripWeight, if_pos ⟨hd, hs'⟩] have huv : (sample L p.2 - sample L p.1).1 ≠ 0 ∨ (sample L p.2 - sample L p.1).2 ≠ 0 := by by_contra hn push_neg at hn have hz := sample_sub_radius hL p rw [hn.1, hn.2, abs_zero, max_self] at hz have hrad : 0 < GridPairs.rho L (GridPairs.displacement p) := by unfold GridPairs.rho exact div_pos (by exact_mod_cast (GridPairs.radius_pos_iff _).mpr hd) (by exact_mod_cast hL) linarith have hc1 : 1 - cutoff r (sample L p.2 - sample L p.1) ≤ 1 := sub_le_self _ (cutoff_nonneg r (sample L p.2 - sample L p.1)) calc _ ≤ pairValue L δ h η p := mul_le_of_le_one_left hK hc1 _ ≤ (1 + δ⁻¹) / max |(sample L p.2 - sample L p.1).1| |(sample L p.2 - sample L p.1).2| := averagedKernel_le hδ huv hh _ _ = _ := by rw [sample_sub_radius hL p]; rfl theorem energy_sub_cutoff_nonneg (L : ℕ) {δ h : ℝ} (hδ : 0 < δ) (hh : 0 < h) (r : ℝ) (η : GridPairs.Grid L → ℝ) : 0 ≤ energy L δ h η - cutoffEnergy L δ h r η := by rw [energy_formula L hδ hh, cutoffEnergy_formula L hδ hh, ← sub_div, ← Finset.sum_sub_distrib] apply div_nonneg _ (by positivity) apply Finset.sum_nonneg intro p hp have := mul_nonneg (sub_nonneg.mpr (cutoff_le_one r (sample L p.2 - sample L p.1))) (pairValue_nonneg L δ hh η p) nlinarith /-- The genuine diagonal contributes exactly `1/(L²*h)`; all other error is in actual strips. -/ theorem energy_sub_cutoff_le {L : ℕ} (hL : 0 < L) {δ h r : ℝ} (hδ : 0 < δ) (hh : 0 < h) (hr : 0 < r) (η : GridPairs.Grid L → ℝ) : energy L δ h η - cutoffEnergy L δ h r η ≤ 1 / ((L : ℝ)^2 * h) + (1 + δ⁻¹) * GridPairs.kernelSum L (stripDisplacements L r) := by have hLr : (0 : ℝ) < L := by exact_mod_cast hL rw [energy_formula L hδ hh, cutoffEnergy_formula L hδ hh, ← sub_div, ← Finset.sum_sub_distrib] calc _ ≤ (∑ p : GridPairs.Grid L × GridPairs.Grid L, ((if p.1 = p.2 then h⁻¹ else 0) + (1 + δ⁻¹) * stripWeight L r (GridPairs.displacement p))) / (L : ℝ)^4 := by apply div_le_div_of_nonneg_right _ (by positivity) apply Finset.sum_le_sum intro p hp simpa only [sub_mul, one_mul] using pair_remainder_le hL hδ hh hr η p _ = _ := by rw [Finset.sum_add_distrib, ← Finset.mul_sum, add_div, mul_div_assoc, stripWeight_sum] congr 1 rw [Fintype.sum_prod_type] simp only [Finset.sum_ite_eq, Finset.sum_ite_eq', Finset.mem_univ, if_true, Finset.sum_const, Finset.card_univ, nsmul_eq_mul, GridPairs.Grid, Fintype.card_prod, Fintype.card_fin, Nat.cast_mul] field_simp [hLr.ne', hh.ne'] <;> ring /-- Explicit uniform finite remainder. Closed width `2*r` allows exactly `r ≤ 1/2`. -/ theorem energy_sub_cutoff_le_explicit {L : ℕ} (hL : 0 < L) {δ h r : ℝ} (hδ : 0 < δ) (hh : 0 < h) (hr : 0 < r) (hr1 : r ≤ 1 / 2) (η : GridPairs.Grid L → ℝ) : energy L δ h η - cutoffEnergy L δ h r η ≤ 1 / ((L : ℝ)^2 * h) + (1 + δ⁻¹) * (20 * ((2 * r) * (1 + |Real.log (2 * r)|) + (1 + Real.log L) / L)) := by apply (energy_sub_cutoff_le hL hδ hh hr η).trans have hs : (1 + δ⁻¹) * GridPairs.kernelSum L (stripDisplacements L r) ≤ (1 + δ⁻¹) * (20 * ((2 * r) * (1 + |Real.log (2 * r)|) + (1 + Real.log L) / L)) := by apply mul_le_mul_of_nonneg_left _ (by positivity) exact GridPairs.actual_strips_bound L hL (2 * r) (by positivity) (by linarith) linarith end DistanceCounts.EmpiricalPairKernel end end BodyFile066 -- Source: DistanceCounts/SquareDifferenceLaw.lean section BodyFile067 /-! The actual difference law of independent uniform points of the unit square. -/ noncomputable section open Set MeasureTheory Filter open scoped Topology namespace DistanceCounts.SquareDifferenceLaw open ParameterKernel ProjectionDensity ProjectionSingularity /-- The probability space consists of two independent uniform square points. -/ def doubleSquareMeasure : Measure ((ℝ × ℝ) × (ℝ × ℝ)) := (parameterMeasure 1).prod (parameterMeasure 1) /-- The actual displacement, with the order matching the ordered grid pairs. -/ def difference (pq : (ℝ × ℝ) × (ℝ × ℝ)) : ℝ × ℝ := pq.2 - pq.1 theorem measurable_difference : Measurable difference := by unfold difference fun_prop def differenceMeasure : Measure (ℝ × ℝ) := Measure.map difference doubleSquareMeasure def weight (d : ℝ × ℝ) : ℝ := kernel 1 d.1 * kernel 1 d.2 theorem doubleSquareMeasure_probability : IsProbabilityMeasure doubleSquareMeasure := by letI := parameterMeasure_probability (by norm_num : (0 : ℝ) < 1) unfold doubleSquareMeasure infer_instance theorem differenceMeasure_probability : IsProbabilityMeasure differenceMeasure := by letI := doubleSquareMeasure_probability exact Measure.isProbabilityMeasure_map measurable_difference.aemeasurable theorem continuous_weight : Continuous weight := ((continuous_kernel 1).comp continuous_fst).mul ((continuous_kernel 1).comp continuous_snd) theorem weight_nonneg (d : ℝ × ℝ) : 0 ≤ weight d := mul_nonneg (kernel_nonneg (by norm_num) _) (kernel_nonneg (by norm_num) _) theorem weight_le_one (d : ℝ × ℝ) : weight d ≤ 1 := by apply mul_le_one₀ · simpa using kernel_le (by norm_num : (0 : ℝ) < 1) d.1 · exact kernel_nonneg (by norm_num) _ · simpa using kernel_le (by norm_num : (0 : ℝ) < 1) d.2 theorem weight_eq_zero_of_not_mem {d : ℝ × ℝ} (hd : d ∉ differenceSquare) : weight d = 0 := by have h : ¬ (|d.1| ≤ 1 ∧ |d.2| ≤ 1) := by intro hh exact hd ⟨abs_le.mp hh.1, abs_le.mp hh.2⟩ rcases not_and_or.mp h with h | h · rw [weight, kernel_eq_zero (by norm_num) (le_of_not_ge h), zero_mul] · rw [weight, kernel_eq_zero (by norm_num) (le_of_not_ge h), mul_zero] theorem support_weight_subset : Function.support weight ⊆ differenceSquare := by intro d hd by_contra hn exact hd (weight_eq_zero_of_not_mem hn) /-- The one-dimensional law is extracted from the previously proved projection formula. Its common translation by one is removed on both sides. -/ theorem integral_scalar_difference {f : ℝ → ℝ} (hf : Continuous f) {M : ℝ} (hM : ∀ x, ‖f x‖ ≤ M) : (∫ p, f (p.2 - p.1) ∂parameterMeasure 1) = ∫ x, kernel 1 x * f x := by have hp := integral_projection (δ := 1) (u := -1) (v := 1) (by norm_num) (by norm_num) (by norm_num) (f := fun x => f (x - 1)) (hf.comp (continuous_id.sub continuous_const)) (fun x => hM (x - 1)) have he (p : ℝ × ℝ) : projection 1 (-1) 1 p - 1 = p.2 - p.1 := by dsimp [projection] ring simp only [he] at hp have hd (x : ℝ) : pairDensity 1 (-1) 1 x = density 1 1 x := by norm_num [pairDensity, leftEndpoint] simp only [hd] at hp rw [hp, ← integral_add_right_eq_self (fun x => density 1 1 x * f (x - 1)) 1] simp only [add_sub_cancel_right, ← kernel_eq_density (by norm_num : (0 : ℝ) < 1)] theorem scalar_differenceMeasure_eq : Measure.map (fun p : ℝ × ℝ => p.2 - p.1) (parameterMeasure 1) = volume.withDensity (fun x => ENNReal.ofReal (kernel 1 x)) := by letI := parameterMeasure_probability (by norm_num : (0 : ℝ) < 1) letI := isFiniteMeasure_withDensity_ofReal (integrable_kernel (by norm_num : (0 : ℝ) < 1)).hasFiniteIntegral apply ext_of_forall_integral_eq_of_IsFiniteMeasure intro f rw [integral_map (by fun_prop) f.continuous.aestronglyMeasurable, integral_withDensity_eq_integral_toReal_smul (continuous_kernel 1).measurable.ennreal_ofReal (ae_of_all _ fun _ => ENNReal.ofReal_lt_top)] simp only [ENNReal.toReal_ofReal (kernel_nonneg (by norm_num : (0 : ℝ) < 1) _), smul_eq_mul] exact integral_scalar_difference f.continuous (fun x => f.norm_coe_le_norm x) /-- Regrouping the four original coordinates is a measure-preserving operation; this is proved by Tonelli, not by assuming transformed independence. -/ def regroup (pq : (ℝ × ℝ) × (ℝ × ℝ)) : (ℝ × ℝ) × (ℝ × ℝ) := ((pq.1.1, pq.2.1), (pq.1.2, pq.2.2)) private theorem lintegral_four (μ : Measure ℝ) [SFinite μ] (f : ((ℝ × ℝ) × (ℝ × ℝ)) → ENNReal) (hf : Measurable f) : (∫⁻ z, f z ∂(μ.prod μ).prod (μ.prod μ)) = ∫⁻ a, ∫⁻ b, ∫⁻ c, ∫⁻ d, f ((a, b), (c, d)) ∂μ ∂μ ∂μ ∂μ := by rw [lintegral_prod _ hf.aemeasurable] calc _ = ∫⁻ a, ∫⁻ b, ∫⁻ q, f ((a, b), q) ∂μ.prod μ ∂μ ∂μ := lintegral_prod _ hf.lintegral_prod_right'.aemeasurable _ = _ := by apply lintegral_congr intro a apply lintegral_congr intro b exact lintegral_prod _ (hf.comp measurable_prodMk_left).aemeasurable theorem map_regroup : Measure.map regroup doubleSquareMeasure = doubleSquareMeasure := by letI := uniformIntervalMeasure_probability (by norm_num : (0 : ℝ) < 1) apply Measure.ext_of_lintegral _ intro f hf rw [lintegral_map hf (by unfold regroup; fun_prop)] change (∫⁻ z, f (regroup z) ∂((uniformIntervalMeasure 1).prod (uniformIntervalMeasure 1)).prod ((uniformIntervalMeasure 1).prod (uniformIntervalMeasure 1))) = _ rw [lintegral_four (uniformIntervalMeasure 1) (fun z => f (regroup z)) (hf.comp (by unfold regroup; fun_prop))] change _ = ∫⁻ z, f z ∂((uniformIntervalMeasure 1).prod (uniformIntervalMeasure 1)).prod ((uniformIntervalMeasure 1).prod (uniformIntervalMeasure 1)) rw [lintegral_four _ _ hf] apply lintegral_congr intro a change (∫⁻ b, ∫⁻ c, ∫⁻ d, f ((a, c), (b, d)) ∂uniformIntervalMeasure 1 ∂uniformIntervalMeasure 1 ∂uniformIntervalMeasure 1) = _ have hg : Measurable (fun z : (ℝ × ℝ) × ℝ => f ((a, z.1.2), (z.1.1, z.2))) := hf.comp (by fun_prop) exact lintegral_lintegral_swap hg.lintegral_prod_right'.aemeasurable /-- The joint difference law is the product of the two scalar difference laws. -/ theorem differenceMeasure_eq_prod : differenceMeasure = (Measure.map (fun p : ℝ × ℝ => p.2 - p.1) (parameterMeasure 1)).prod (Measure.map (fun p : ℝ × ℝ => p.2 - p.1) (parameterMeasure 1)) := by letI := parameterMeasure_probability (by norm_num : (0 : ℝ) < 1) rw [Measure.map_prod_map _ _ (by fun_prop) (by fun_prop)] change Measure.map difference doubleSquareMeasure = Measure.map (Prod.map (fun p : ℝ × ℝ => p.2 - p.1) (fun p : ℝ × ℝ => p.2 - p.1)) doubleSquareMeasure nth_rw 2 [← map_regroup] rw [Measure.map_map (by fun_prop) (by unfold regroup; fun_prop)] rfl /-- Exact planar pushforward density of two independent uniform square points. -/ theorem differenceMeasure_eq_withDensity : differenceMeasure = volume.withDensity (fun d => ENNReal.ofReal (weight d)) := by rw [differenceMeasure_eq_prod, scalar_differenceMeasure_eq, prod_withDensity (continuous_kernel 1).measurable.ennreal_ofReal (continuous_kernel 1).measurable.ennreal_ofReal, ← Measure.volume_eq_prod] congr 1 funext d exact (ENNReal.ofReal_mul (kernel_nonneg (by norm_num) _)).symm theorem integral_difference {f : (ℝ × ℝ) → ℝ} (hf : Measurable f) : (∫ pq, f (difference pq) ∂doubleSquareMeasure) = ∫ d, weight d * f d := by rw [← integral_map measurable_difference.aemeasurable hf.aestronglyMeasurable] change (∫ d, f d ∂differenceMeasure) = _ rw [differenceMeasure_eq_withDensity, integral_withDensity_eq_integral_toReal_smul continuous_weight.measurable.ennreal_ofReal (ae_of_all _ fun _ => ENNReal.ofReal_lt_top)] simp only [ENNReal.toReal_ofReal (weight_nonneg _), smul_eq_mul] theorem integrable_weight_invRadius : Integrable (fun d => weight d * invRadius d) := by have hi : Integrable (differenceSquare.indicator invRadius) := (integrable_indicator_iff measurableSet_differenceSquare).mpr integrableOn_invRadius apply hi.mono' (continuous_weight.measurable.mul measurable_invRadius).aestronglyMeasurable apply ae_of_all intro d change ‖weight d * invRadius d‖ ≤ differenceSquare.indicator invRadius d rw [Real.norm_of_nonneg (mul_nonneg (weight_nonneg d) (invRadius_nonneg d))] by_cases hd : d ∈ differenceSquare · rw [indicator_of_mem hd] exact mul_le_of_le_one_left (invRadius_nonneg d) (weight_le_one d) · simp [indicator_of_notMem hd, weight_eq_zero_of_not_mem hd] theorem integrable_invRadius_differenceMeasure : Integrable invRadius differenceMeasure := by rw [differenceMeasure_eq_withDensity, integrable_withDensity_iff_integrable_smul' continuous_weight.measurable.ennreal_ofReal (ae_of_all _ fun _ => ENNReal.ofReal_lt_top)] simpa only [ENNReal.toReal_ofReal (weight_nonneg _), smul_eq_mul] using integrable_weight_invRadius theorem integrable_invRadius_difference : Integrable (fun pq => invRadius (difference pq)) doubleSquareMeasure := integrable_invRadius_differenceMeasure.comp_measurable measurable_difference theorem differenceMeasure_axes : differenceMeasure axes = 0 := by rw [differenceMeasure_eq_withDensity] exact withDensity_absolutelyContinuous _ _ volume_axes theorem differenceMeasure_fst_axis : differenceMeasure {d | d.1 = 0} = 0 := by rw [differenceMeasure_eq_withDensity] exact withDensity_absolutelyContinuous _ _ volume_fst_axis theorem differenceMeasure_snd_axis : differenceMeasure {d | d.2 = 0} = 0 := by rw [differenceMeasure_eq_withDensity] exact withDensity_absolutelyContinuous _ _ volume_snd_axis theorem doubleSquareMeasure_difference_axes : doubleSquareMeasure {pq | difference pq ∈ axes} = 0 := by have hm : MeasurableSet axes := (measurableSet_eq_fun measurable_fst measurable_const).union (measurableSet_eq_fun measurable_snd measurable_const) change doubleSquareMeasure (difference ⁻¹' axes) = 0 simpa only [differenceMeasure, Measure.map_apply measurable_difference hm] using differenceMeasure_axes end DistanceCounts.SquareDifferenceLaw end end BodyFile067 -- Source: DistanceCounts/ContinuumEnergy.lean section BodyFile068 /-! The genuine square projection law and its triangular-kernel energy. -/ noncomputable section open Set MeasureTheory Filter namespace DistanceCounts.ContinuumEnergy open ProjectionDensity ParameterKernel /-- The ordinary linear projection of the uniform unit square. -/ def dot (a b : ℝ) (u : ℝ × ℝ) : ℝ := a * u.1 + b * u.2 theorem continuous_dot (a b : ℝ) : Continuous (dot a b) := by unfold dot fun_prop /-- Removing the common translation from the actual parameter projection law. -/ theorem integral_dot {a b : ℝ} (ha : 0 < a) (hb : 0 < b) {f : ℝ → ℝ} (hf : Continuous f) {M : ℝ} (hM : ∀ x, ‖f x‖ ≤ M) : (∫ u, f (dot a b u) ∂parameterMeasure 1) = ∫ t, density a b t * f t := by have hshift (u : ℝ × ℝ) : projection 1 a b u - b = dot a b u := by dsimp [projection, dot] ring have hpair : pairDensity 1 a b = fun t => density a b (t - b) := by funext t simp [pairDensity, leftEndpoint, abs_of_pos ha, abs_of_pos hb, min_eq_right ha.le, min_eq_right hb.le] calc (∫ u, f (dot a b u) ∂parameterMeasure 1) = ∫ u, f (projection 1 a b u - b) ∂parameterMeasure 1 := by simp_rw [hshift] _ = ∫ t, pairDensity 1 a b t * f (t - b) := integral_projection (by norm_num) ha.ne' hb.ne' (hf.comp (continuous_id.sub continuous_const)) (fun t => hM (t - b)) _ = ∫ t, density a b t * f t := by rw [hpair] exact integral_sub_right_eq_self (fun t => density a b t * f t) b theorem integrable_dot_test (a b : ℝ) {f : ℝ → ℝ} (hf : Continuous f) {M : ℝ} (hM : ∀ x, ‖f x‖ ≤ M) : Integrable (fun u => f (dot a b u)) (parameterMeasure 1) := by letI := parameterMeasure_probability (by norm_num : (0 : ℝ) < 1) exact Integrable.of_bound (hf.comp (continuous_dot a b)).aestronglyMeasurable M (Eventually.of_forall fun u => hM _) /-- The density bound does not require either side length to be at most one. -/ theorem density_le {a b : ℝ} (ha : 0 < a) (hb : 0 < b) (t : ℝ) : density a b t ≤ 1 / a := by rw [density_eq_integral_swap] calc (∫ s, box a (t - s) * box b s) ≤ ∫ s, (1 / a) * box b s := integral_mono (integrable_box_product_swap ha hb t) ((integrable_box b).const_mul _) (fun s => mul_le_mul_of_nonneg_right (box_le ha _) (box_nonneg hb _)) _ = 1 / a := by rw [integral_const_mul, integral_box hb, mul_one] theorem integrable_density_sq {a b : ℝ} (ha : 0 < a) (hb : 0 < b) : Integrable (fun t => density a b t ^ 2) := by simpa only [pow_two] using (integrable_density a b).mul_bdd (continuous_density a b).aestronglyMeasurable (Eventually.of_forall fun t => by rw [Real.norm_eq_abs, abs_of_nonneg (density_nonneg ha hb t)] exact density_le ha hb t) /-- Uniform domination for the later parameter integral. -/ theorem integral_density_sq_le {a b : ℝ} (ha : 0 < a) (hb : 0 < b) : (∫ t, density a b t ^ 2) ≤ 1 / a := by calc (∫ t, density a b t ^ 2) ≤ ∫ t, density a b t * (1 / a) := by apply integral_mono (integrable_density_sq ha hb) ((integrable_density a b).mul_const _) intro t change density a b t ^ 2 ≤ density a b t * (1 / a) rw [pow_two] exact mul_le_mul_of_nonneg_left (density_le ha hb t) (density_nonneg ha hb t) _ = 1 / a := by rw [integral_mul_const, integral_density ha hb, one_mul] /-- The density tested against the actual triangular kernel. -/ def densityKernel (a b h z : ℝ) : ℝ := ∫ t, density a b t * kernel h (t - z) theorem integrable_density_kernel (a b : ℝ) {h : ℝ} (hh : 0 < h) (z : ℝ) : Integrable (fun t => density a b t * kernel h (t - z)) := by exact (integrable_density a b).mul_bdd ((continuous_kernel h).comp (continuous_id.sub continuous_const)).aestronglyMeasurable (Eventually.of_forall fun t => by rw [Real.norm_eq_abs, abs_of_nonneg (kernel_nonneg hh _)] exact kernel_le hh _) theorem densityKernel_eq_convolution (a b h : ℝ) : densityKernel a b h = convolution (density a b) (kernel h) (ContinuousLinearMap.mul ℝ ℝ) volume := by funext z rw [convolution_mul] unfold densityKernel apply integral_congr_ae filter_upwards with t simp only [kernel, abs_sub_comm] theorem continuous_densityKernel (a b : ℝ) {h : ℝ} (hh : 0 < h) : Continuous (densityKernel a b h) := by rw [densityKernel_eq_convolution] exact (kernel_hasCompactSupport hh).continuous_convolution_right (L := ContinuousLinearMap.mul ℝ ℝ) (integrable_density a b).locallyIntegrable (continuous_kernel h) theorem densityKernel_nonneg {a b h : ℝ} (ha : 0 < a) (hb : 0 < b) (hh : 0 < h) (z : ℝ) : 0 ≤ densityKernel a b h z := integral_nonneg fun t => mul_nonneg (density_nonneg ha hb t) (kernel_nonneg hh _) theorem densityKernel_le {a b h : ℝ} (ha : 0 < a) (hb : 0 < b) (hh : 0 < h) (z : ℝ) : densityKernel a b h z ≤ h⁻¹ := by calc densityKernel a b h z ≤ ∫ t, density a b t * h⁻¹ := integral_mono (integrable_density_kernel a b hh z) ((integrable_density a b).mul_const _) (fun t => mul_le_mul_of_nonneg_left (kernel_le hh _) (density_nonneg ha hb t)) _ = h⁻¹ := by rw [integral_mul_const, integral_density ha hb, one_mul] /-- Kernel support, mass one, and the sharp density Lipschitz estimate. -/ theorem densityKernel_error {a b h : ℝ} (ha : 0 < a) (hb : 0 < b) (hh : 0 < h) (z : ℝ) : |densityKernel a b h z - density a b z| ≤ h / (a * b) := by have hk : Integrable (fun t => kernel h (t - z)) := (integrable_kernel hh).comp_sub_right z have he : (∫ t, (density a b t - density a b z) * kernel h (t - z)) = densityKernel a b h z - density a b z := by simp_rw [sub_mul] rw [integral_sub (integrable_density_kernel a b hh z) (hk.const_mul _), integral_const_mul, integral_kernel_translate hh, mul_one] rfl rw [← he, ← Real.norm_eq_abs] calc ‖∫ t, (density a b t - density a b z) * kernel h (t - z)‖ ≤ ∫ t, (h / (a * b)) * kernel h (t - z) := by apply norm_integral_le_of_norm_le (hk.const_mul _) filter_upwards with t rw [Real.norm_eq_abs, abs_mul, abs_of_nonneg (kernel_nonneg hh _)] by_cases ht : |t - z| ≤ h · exact mul_le_mul_of_nonneg_right ((density_abs_sub_le ha hb t z).trans (div_le_div_of_nonneg_right ht (mul_pos ha hb).le)) (kernel_nonneg hh _) · rw [kernel_eq_zero hh (le_of_not_ge ht)] simp _ = h / (a * b) := by rw [integral_const_mul, integral_kernel_translate hh, mul_one] /-- The genuine double unit-square energy, not a density-side definition. -/ def continuumEnergy (a b h : ℝ) : ℝ := ∫ p, ∫ q, kernel h (dot a b q - dot a b p) ∂parameterMeasure 1 ∂parameterMeasure 1 theorem integrable_square_kernel (a b : ℝ) {h : ℝ} (hh : 0 < h) : Integrable (fun pq : (ℝ × ℝ) × (ℝ × ℝ) => kernel h (dot a b pq.2 - dot a b pq.1)) ((parameterMeasure 1).prod (parameterMeasure 1)) := by letI := parameterMeasure_probability (by norm_num : (0 : ℝ) < 1) apply Integrable.of_bound (C := h⁻¹) · exact ((continuous_kernel h).comp (((continuous_dot a b).comp continuous_snd).sub ((continuous_dot a b).comp continuous_fst))).aestronglyMeasurable · filter_upwards with pq rw [Real.norm_eq_abs, abs_of_nonneg (kernel_nonneg hh _)] exact kernel_le hh _ theorem integrable_square_energy (a b : ℝ) {h : ℝ} (hh : 0 < h) : Integrable (fun p => ∫ q, kernel h (dot a b q - dot a b p) ∂parameterMeasure 1) (parameterMeasure 1) := by letI := parameterMeasure_probability (by norm_num : (0 : ℝ) < 1) exact (integrable_square_kernel a b hh).integral_prod_left theorem continuumEnergy_eq_prod (a b : ℝ) {h : ℝ} (hh : 0 < h) : continuumEnergy a b h = ∫ pq : (ℝ × ℝ) × (ℝ × ℝ), kernel h (dot a b pq.2 - dot a b pq.1) ∂(parameterMeasure 1).prod (parameterMeasure 1) := by letI := parameterMeasure_probability (by norm_num : (0 : ℝ) < 1) exact (integral_prod _ (integrable_square_kernel a b hh)).symm theorem integrable_density_energy {a b h : ℝ} (ha : 0 < a) (hb : 0 < b) (hh : 0 < h) : Integrable (fun t => density a b t * densityKernel a b h t) := by exact (integrable_density a b).mul_bdd (continuous_densityKernel a b hh).aestronglyMeasurable (Eventually.of_forall fun t => by rw [Real.norm_eq_abs, abs_of_nonneg (densityKernel_nonneg ha hb hh t)] exact densityKernel_le ha hb hh t) /-- Both square projections are performed against bounded continuous test functions. -/ theorem continuumEnergy_eq_integral {a b h : ℝ} (ha : 0 < a) (hb : 0 < b) (hh : 0 < h) : continuumEnergy a b h = ∫ t, density a b t * densityKernel a b h t := by have hinner (p : ℝ × ℝ) : (∫ q, kernel h (dot a b q - dot a b p) ∂parameterMeasure 1) = densityKernel a b h (dot a b p) := integral_dot ha hb ((continuous_kernel h).comp (continuous_id.sub continuous_const)) (fun t => by change ‖kernel h (t - dot a b p)‖ ≤ h⁻¹ rw [Real.norm_eq_abs, abs_of_nonneg (kernel_nonneg hh _)] exact kernel_le hh _) unfold continuumEnergy simp_rw [hinner] exact integral_dot ha hb (continuous_densityKernel a b hh) (fun t => by rw [Real.norm_eq_abs, abs_of_nonneg (densityKernel_nonneg ha hb hh t)] exact densityKernel_le ha hb hh t) theorem integrable_density_double_kernel (a b : ℝ) {h : ℝ} (hh : 0 < h) : Integrable (fun xy : ℝ × ℝ => density a b xy.1 * density a b xy.2 * kernel h (xy.2 - xy.1)) (volume.prod volume) := by exact ((integrable_density a b).mul_prod (integrable_density a b)).mul_bdd ((continuous_kernel h).comp (continuous_snd.sub continuous_fst)).aestronglyMeasurable (Eventually.of_forall fun xy => by rw [Real.norm_eq_abs, abs_of_nonneg (kernel_nonneg hh _)] exact kernel_le hh _) /-- The explicit density-weighted double Lebesgue integral. -/ theorem continuumEnergy_eq_double_integral {a b h : ℝ} (ha : 0 < a) (hb : 0 < b) (hh : 0 < h) : continuumEnergy a b h = ∫ x, ∫ y, density a b x * density a b y * kernel h (y - x) := by rw [continuumEnergy_eq_integral ha hb hh] apply integral_congr_ae filter_upwards with x simp only [densityKernel, ← integral_const_mul, mul_assoc] /-- The density-side Fubini identification also holds for the product Lebesgue integral. -/ theorem continuumEnergy_eq_density_prod {a b h : ℝ} (ha : 0 < a) (hb : 0 < b) (hh : 0 < h) : continuumEnergy a b h = ∫ xy : ℝ × ℝ, density a b xy.1 * density a b xy.2 * kernel h (xy.2 - xy.1) ∂volume.prod volume := by rw [continuumEnergy_eq_double_integral ha hb hh] exact (integral_prod _ (integrable_density_double_kernel a b hh)).symm /-- Quantitative continuum approximation, with no density-law or energy-identity hypothesis. -/ theorem continuumEnergy_error {a b h : ℝ} (ha : 0 < a) (hb : 0 < b) (hh : 0 < h) : |continuumEnergy a b h - ∫ t, density a b t ^ 2| ≤ h / (a * b) := by rw [continuumEnergy_eq_integral ha hb hh, ← integral_sub (integrable_density_energy ha hb hh) (integrable_density_sq ha hb), ← Real.norm_eq_abs] calc ‖∫ t, density a b t * densityKernel a b h t - density a b t ^ 2‖ ≤ ∫ t, density a b t * (h / (a * b)) := by apply norm_integral_le_of_norm_le ((integrable_density a b).mul_const _) filter_upwards with t rw [show density a b t * densityKernel a b h t - density a b t ^ 2 = density a b t * (densityKernel a b h t - density a b t) by ring, Real.norm_eq_abs, abs_mul, abs_of_nonneg (density_nonneg ha hb t)] exact mul_le_mul_of_nonneg_left (densityKernel_error ha hb hh t) (density_nonneg ha hb t) _ = h / (a * b) := by rw [integral_mul_const, integral_density ha hb, one_mul] end DistanceCounts.ContinuumEnergy end end BodyFile068 -- Source: DistanceCounts/ProjectionContinuumLimit.lean section BodyFile069 noncomputable section open Set MeasureTheory Filter open scoped Topology namespace DistanceCounts.ProjectionContinuumLimit open ParameterKernel ProjectionDensity ProjectionSingularity SquareDifferenceLaw ContinuumEnergy /-- The limiting pair density is the actual parameter projection density at zero. -/ def limitDensity (δ : ℝ) (d : ℝ × ℝ) : ℝ := pairDensity δ d.1 d.2 0 def limitEnergy (δ : ℝ) : ℝ := ∫ d, limitDensity δ d ∂differenceMeasure /-- The canonical reference energy, without any alternative density convention. -/ def referenceEnergy (δ : ℝ) (a : ℝ × ℝ) : ℝ := ∫ t, density (1 - δ + a.1) (1 + a.2) t ^ 2 theorem measurable_limitDensity (δ : ℝ) : Measurable (limitDensity δ) := by unfold limitDensity pairDensity density leftEndpoint fun_prop theorem limitDensity_nonneg {δ : ℝ} (hδ : 0 < δ) (d : ℝ × ℝ) : 0 ≤ limitDensity δ d := by unfold limitDensity pairDensity density exact div_nonneg (le_max_left _ _) (mul_nonneg (mul_nonneg hδ.le (abs_nonneg _)) (abs_nonneg _)) theorem ae_difference_coordinates_ne_zero : ∀ᵐ d ∂differenceMeasure, d.1 ≠ 0 ∧ d.2 ≠ 0 := by have h : ∀ᵐ d ∂differenceMeasure, d ∉ axes := by rw [ae_iff] simpa using differenceMeasure_axes filter_upwards [h] with d hd simpa only [axes, mem_setOf_eq, not_or] using hd private theorem eventually_pos : ∀ᶠ h : ℝ in 𝓝[>] 0, 0 < h := self_mem_nhdsWithin theorem tendsto_averagedKernel_zero {δ : ℝ} (hδ : 0 < δ) {d : ℝ × ℝ} (hu : d.1 ≠ 0) (hv : d.2 ≠ 0) : Tendsto (fun h => averagedKernel δ d.1 d.2 h 0) (𝓝[>] 0) (𝓝 (limitDensity δ d)) := by simpa only [add_zero, limitDensity] using tendsto_averagedKernel (h := fun h : ℝ => h) (e := fun _ : ℝ => 0) hδ hu hv 0 eventually_pos (tendsto_id.mono_left nhdsWithin_le_nhds) tendsto_const_nhds theorem limitDensity_le {δ : ℝ} (hδ : 0 < δ) {d : ℝ × ℝ} (hu : d.1 ≠ 0) (hv : d.2 ≠ 0) : limitDensity δ d ≤ (1 + δ⁻¹) * invRadius d := by apply le_of_tendsto (tendsto_averagedKernel_zero hδ hu hv) filter_upwards [eventually_pos] with h hh simpa only [invRadius, div_eq_mul_inv, one_mul] using averagedKernel_le hδ (Or.inl hu) hh (0 : ℝ) theorem ae_limitDensity_le {δ : ℝ} (hδ : 0 < δ) : ∀ᵐ d ∂differenceMeasure, limitDensity δ d ≤ (1 + δ⁻¹) * invRadius d := by filter_upwards [ae_difference_coordinates_ne_zero] with d hd exact limitDensity_le hδ hd.1 hd.2 theorem integrable_limitDensity {δ : ℝ} (hδ : 0 < δ) : Integrable (limitDensity δ) differenceMeasure := by apply (integrable_invRadius_differenceMeasure.const_mul (1 + δ⁻¹)).mono' (measurable_limitDensity δ).aestronglyMeasurable filter_upwards [ae_limitDensity_le hδ] with d hd simpa only [Real.norm_of_nonneg (limitDensity_nonneg hδ d)] using hd theorem limitEnergy_nonneg {δ : ℝ} (hδ : 0 < δ) : 0 ≤ limitEnergy δ := integral_nonneg (limitDensity_nonneg hδ) theorem integrable_cutoff_limitDensity {δ : ℝ} (hδ : 0 < δ) (r : ℝ) : Integrable (fun d => cutoff r d * limitDensity δ d) differenceMeasure := by apply (integrable_limitDensity hδ).mono' ((continuous_cutoff r).measurable.mul (measurable_limitDensity δ)).aestronglyMeasurable filter_upwards with d change ‖cutoff r d * limitDensity δ d‖ ≤ limitDensity δ d rw [Real.norm_of_nonneg (mul_nonneg (cutoff_nonneg r d) (limitDensity_nonneg hδ d))] exact mul_le_of_le_one_left (limitDensity_nonneg hδ d) (cutoff_le_one r d) theorem tendsto_cutoff {d : ℝ × ℝ} (hu : d.1 ≠ 0) (hv : d.2 ≠ 0) : Tendsto (fun r => cutoff r d) (𝓝[>] 0) (𝓝 1) := by apply tendsto_const_nhds.congr' filter_upwards [eventually_pos, (eventually_lt_nhds (half_pos (abs_pos.mpr hu))).filter_mono nhdsWithin_le_nhds, (eventually_lt_nhds (half_pos (abs_pos.mpr hv))).filter_mono nhdsWithin_le_nhds] with r hr hru hrv exact (cutoff_eq_one hr (by linarith) (by linarith)).symm theorem tendsto_integral_cutoff_limitDensity {δ : ℝ} (hδ : 0 < δ) : Tendsto (fun r => ∫ d, cutoff r d * limitDensity δ d ∂differenceMeasure) (𝓝[>] 0) (𝓝 (limitEnergy δ)) := by apply tendsto_integral_filter_of_dominated_convergence (limitDensity δ) · exact Eventually.of_forall fun r => ((continuous_cutoff r).measurable.mul (measurable_limitDensity δ)).aestronglyMeasurable · exact Eventually.of_forall fun r => ae_of_all _ fun d => by rw [Real.norm_of_nonneg (mul_nonneg (cutoff_nonneg r d) (limitDensity_nonneg hδ d))] exact mul_le_of_le_one_left (limitDensity_nonneg hδ d) (cutoff_le_one r d) · exact integrable_limitDensity hδ · filter_upwards [ae_difference_coordinates_ne_zero] with d hd simpa only [one_mul] using (tendsto_cutoff hd.1 hd.2).mul_const (limitDensity δ d) /-- Joint measurability uses the actual bounded triangular kernel. -/ theorem measurable_joint_kernel (δ h : ℝ) : Measurable (fun da : (ℝ × ℝ) × (ℝ × ℝ) => kernel h (projection δ da.1.1 da.1.2 da.2)) := by apply (continuous_kernel h).measurable.comp unfold projection fun_prop theorem measurable_averagedKernel {δ : ℝ} (hδ : 0 < δ) (h : ℝ) : Measurable (fun d : ℝ × ℝ => averagedKernel δ d.1 d.2 h 0) := by letI := parameterMeasure_probability hδ simpa only [averagedKernel, sub_zero] using (measurable_joint_kernel δ h).stronglyMeasurable.integral_prod_right'.measurable theorem integrable_joint_kernel {δ h : ℝ} (hδ : 0 < δ) (hh : 0 < h) : Integrable (fun da : (ℝ × ℝ) × (ℝ × ℝ) => kernel h (projection δ da.1.1 da.1.2 da.2)) (differenceMeasure.prod (parameterMeasure δ)) := by letI := differenceMeasure_probability letI := parameterMeasure_probability hδ apply Integrable.of_bound (measurable_joint_kernel δ h).aestronglyMeasurable (h⁻¹) exact ae_of_all _ fun da => by rw [Real.norm_of_nonneg (kernel_nonneg hh _)] exact kernel_le hh _ theorem integrable_averagedKernel {δ h : ℝ} (hδ : 0 < δ) (hh : 0 < h) : Integrable (fun d : ℝ × ℝ => averagedKernel δ d.1 d.2 h 0) differenceMeasure := by letI := parameterMeasure_probability hδ simpa only [averagedKernel, sub_zero] using (integrable_joint_kernel hδ hh).integral_prod_left theorem tendsto_integral_averagedKernel {δ : ℝ} (hδ : 0 < δ) : Tendsto (fun h => ∫ d, averagedKernel δ d.1 d.2 h 0 ∂differenceMeasure) (𝓝[>] 0) (𝓝 (limitEnergy δ)) := by apply tendsto_integral_filter_of_dominated_convergence (fun d => (1 + δ⁻¹) * invRadius d) · exact Eventually.of_forall fun h => (measurable_averagedKernel hδ h).aestronglyMeasurable · filter_upwards [eventually_pos] with h hh filter_upwards [ae_difference_coordinates_ne_zero] with d hd rw [Real.norm_of_nonneg (averagedKernel_nonneg hh _ _ _ _)] simpa only [invRadius, div_eq_mul_inv, one_mul] using averagedKernel_le hδ (Or.inl hd.1) hh (0 : ℝ) · exact integrable_invRadius_differenceMeasure.const_mul _ · filter_upwards [ae_difference_coordinates_ne_zero] with d hd exact tendsto_averagedKernel_zero hδ hd.1 hd.2 /-- Support is proved directly for the normalized restricted Lebesgue laws. -/ theorem ae_parameter_support {δ : ℝ} (hδ : 0 < δ) : ∀ᵐ a ∂parameterMeasure δ, a.1 ∈ Icc 0 δ ∧ a.2 ∈ Icc 0 1 := by letI := uniformIntervalMeasure_probability hδ letI := uniformIntervalMeasure_probability (by norm_num : (0 : ℝ) < 1) have hi (b : ℝ) : ∀ᵐ x ∂uniformIntervalMeasure b, x ∈ Icc 0 b := by unfold uniformIntervalMeasure apply Measure.ae_smul_measure filter_upwards [ae_restrict_mem measurableSet_Ico] with x hx exact ⟨hx.1, hx.2.le⟩ unfold parameterMeasure apply (Measure.ae_prod_iff_ae_ae ((measurable_fst measurableSet_Icc).inter (measurable_snd measurableSet_Icc))).mpr filter_upwards [hi δ] with r hr filter_upwards [hi 1] with s hs exact ⟨hr, hs⟩ theorem measurable_referenceEnergy (δ : ℝ) : Measurable (referenceEnergy δ) := by have hm : Measurable (fun z : (ℝ × ℝ) × ℝ => density (1 - δ + z.1.1) (1 + z.1.2) z.2 ^ 2) := by unfold density fun_prop exact hm.stronglyMeasurable.integral_prod_right'.measurable theorem referenceEnergy_nonneg (δ : ℝ) (a : ℝ × ℝ) : 0 ≤ referenceEnergy δ a := integral_nonneg (fun _ => sq_nonneg _) theorem referenceEnergy_le {δ : ℝ} (hδ1 : δ < 1) {a : ℝ × ℝ} (ha : a.1 ∈ Icc 0 δ ∧ a.2 ∈ Icc 0 1) : referenceEnergy δ a ≤ 1 / (1 - δ) := by have hα : 0 < 1 - δ + a.1 := by linarith [ha.1.1] have hβ : 0 < 1 + a.2 := by linarith [ha.2.1] exact (integral_density_sq_le hα hβ).trans (one_div_le_one_div_of_le (by linarith) (by linarith [ha.1.1])) theorem integrable_referenceEnergy {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) : Integrable (referenceEnergy δ) (parameterMeasure δ) := by letI := parameterMeasure_probability hδ apply Integrable.of_bound (measurable_referenceEnergy δ).aestronglyMeasurable (1 / (1 - δ)) filter_upwards [ae_parameter_support hδ] with a ha rw [Real.norm_of_nonneg (referenceEnergy_nonneg δ a)] exact referenceEnergy_le hδ1 ha /-- Transport through the genuine pushforward displacement law. -/ theorem continuumEnergy_eq_difference (δ : ℝ) (a : ℝ × ℝ) {h : ℝ} (hh : 0 < h) : continuumEnergy (1 - δ + a.1) (1 + a.2) h = ∫ d, kernel h (projection δ d.1 d.2 a) ∂differenceMeasure := by rw [continuumEnergy_eq_prod _ _ hh] change (∫ pq, kernel h (dot (1 - δ + a.1) (1 + a.2) pq.2 - dot (1 - δ + a.1) (1 + a.2) pq.1) ∂doubleSquareMeasure) = _ have hk : Continuous (fun d : ℝ × ℝ => kernel h (projection δ d.1 d.2 a)) := by apply (continuous_kernel h).comp unfold projection fun_prop rw [differenceMeasure, integral_map measurable_difference.aemeasurable hk.aestronglyMeasurable] apply integral_congr_ae filter_upwards with pq congr 1 dsimp [dot, projection, difference] ring theorem measurable_parameter_continuumEnergy (δ : ℝ) {h : ℝ} (hh : 0 < h) : Measurable (fun a : ℝ × ℝ => continuumEnergy (1 - δ + a.1) (1 + a.2) h) := by letI := differenceMeasure_probability simp_rw [continuumEnergy_eq_difference δ _ hh] exact (measurable_joint_kernel δ h).stronglyMeasurable.integral_prod_left'.measurable theorem integrable_parameter_continuumEnergy {δ h : ℝ} (hδ : 0 < δ) (hh : 0 < h) : Integrable (fun a : ℝ × ℝ => continuumEnergy (1 - δ + a.1) (1 + a.2) h) (parameterMeasure δ) := by letI := differenceMeasure_probability letI := parameterMeasure_probability hδ simp_rw [continuumEnergy_eq_difference δ _ hh] exact (integrable_joint_kernel hδ hh).integral_prod_right /-- Bounded-kernel Fubini, before any limiting operation. -/ theorem integral_averagedKernel_eq_continuumEnergy {δ h : ℝ} (hδ : 0 < δ) (hh : 0 < h) : (∫ d, averagedKernel δ d.1 d.2 h 0 ∂differenceMeasure) = ∫ a, continuumEnergy (1 - δ + a.1) (1 + a.2) h ∂parameterMeasure δ := by letI := differenceMeasure_probability letI := parameterMeasure_probability hδ simp_rw [averagedKernel, sub_zero, continuumEnergy_eq_difference δ _ hh] exact integral_integral_swap (integrable_joint_kernel hδ hh) theorem parameter_continuumEnergy_error {δ h : ℝ} (hδ1 : δ < 1) (hh : 0 < h) {a : ℝ × ℝ} (ha : a.1 ∈ Icc 0 δ ∧ a.2 ∈ Icc 0 1) : |continuumEnergy (1 - δ + a.1) (1 + a.2) h - referenceEnergy δ a| ≤ h / (1 - δ) := by have hα : 0 < 1 - δ + a.1 := by linarith [ha.1.1] have hβ : 0 < 1 + a.2 := by linarith [ha.2.1] have hab : 1 - δ ≤ (1 - δ + a.1) * (1 + a.2) := by nlinarith [ha.1.1, ha.2.1, mul_nonneg hα.le ha.2.1] exact (continuumEnergy_error hα hβ hh).trans (div_le_div_of_nonneg_left hh.le (by linarith) hab) theorem integral_parameter_continuumEnergy_error {δ h : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (hh : 0 < h) : |(∫ a, continuumEnergy (1 - δ + a.1) (1 + a.2) h ∂parameterMeasure δ) - ∫ a, referenceEnergy δ a ∂parameterMeasure δ| ≤ h / (1 - δ) := by letI := parameterMeasure_probability hδ rw [← integral_sub (integrable_parameter_continuumEnergy hδ hh) (integrable_referenceEnergy hδ hδ1), ← Real.norm_eq_abs] calc ‖∫ a, continuumEnergy (1 - δ + a.1) (1 + a.2) h - referenceEnergy δ a ∂parameterMeasure δ‖ ≤ ∫ _ : ℝ × ℝ, h / (1 - δ) ∂parameterMeasure δ := by apply norm_integral_le_of_norm_le (integrable_const _) filter_upwards [ae_parameter_support hδ] with a ha simpa only [Real.norm_eq_abs] using parameter_continuumEnergy_error hδ1 hh ha _ = h / (1 - δ) := by simp theorem tendsto_integral_parameter_continuumEnergy {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) : Tendsto (fun h => ∫ a, continuumEnergy (1 - δ + a.1) (1 + a.2) h ∂parameterMeasure δ) (𝓝[>] 0) (𝓝 (∫ a, referenceEnergy δ a ∂parameterMeasure δ)) := by apply tendsto_iff_norm_sub_tendsto_zero.mpr apply squeeze_zero' (Eventually.of_forall fun _ => norm_nonneg _) · filter_upwards [eventually_pos] with h hh simpa only [Real.norm_eq_abs] using integral_parameter_continuumEnergy_error hδ hδ1 hh · have hzero : Tendsto (fun h : ℝ => h) (𝓝[>] 0) (𝓝 (0 : ℝ)) := tendsto_id.mono_left nhdsWithin_le_nhds simpa only [zero_div] using hzero.div_const (1 - δ) /-- The target is identified from the real parameter law and the real square law; no continuum-density identity or spectral-limit assumption is an input. -/ theorem limitEnergy_eq_referenceEnergy {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) : limitEnergy δ = ∫ a, referenceEnergy δ a ∂parameterMeasure δ := by apply tendsto_nhds_unique (tendsto_integral_averagedKernel hδ) apply (tendsto_integral_parameter_continuumEnergy hδ hδ1).congr' filter_upwards [eventually_pos] with h hh exact (integral_averagedKernel_eq_continuumEnergy hδ hh).symm theorem limitEnergy_eq_density_integral {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) : limitEnergy δ = ∫ a : ℝ × ℝ, ∫ t : ℝ, density (1 - δ + a.1) (1 + a.2) t ^ 2 ∂volume ∂parameterMeasure δ := limitEnergy_eq_referenceEnergy hδ hδ1 end DistanceCounts.ProjectionContinuumLimit end end BodyFile069 -- Source: DistanceCounts/MesoscopicEnergy.lean section BodyFile070 /-! Mesoscopic empirical energy at bandwidths with only `L² h → ∞`. -/ noncomputable section namespace DistanceCounts.MesoscopicEnergy open Filter MeasureTheory Set open ParameterKernel EmpiricalPairKernel GridQuadrature ProjectionSingularity open ProjectionContinuumLimit SquareDifferenceLaw open scoped Topology def cutoffIntegral (δ r : ℝ) : ℝ := ∫ d, cutoffLimit δ r d ∂differenceMeasure theorem tendsto_grid_cutoff {δ r : ℝ} (hδ : 0 < δ) (hr : 0 < r) : Tendsto (fun L : ℕ => gridPairAverage L (cutoffLimit δ r)) atTop (𝓝 (cutoffIntegral δ r)) := by letI := parameterMeasure_probability (by norm_num : (0 : ℝ) < 1) have hc := continuous_cutoffLimit hδ hr have hq := tendsto_gridPairAverage hc rw [← integral_prod _ (integrable_difference hc)] at hq have hm : (∫ pq, cutoffLimit δ r (difference pq) ∂doubleSquareMeasure) = cutoffIntegral δ r := by unfold cutoffIntegral differenceMeasure rw [integral_map measurable_difference.aemeasurable hc.aestronglyMeasurable] change Tendsto (fun L : ℕ => gridPairAverage L (cutoffLimit δ r)) atTop (𝓝 (∫ pq, cutoffLimit δ r (difference pq) ∂doubleSquareMeasure)) at hq rw [hm] at hq exact hq theorem tendsto_cutoffIntegral {δ : ℝ} (hδ : 0 < δ) : Tendsto (cutoffIntegral δ) (𝓝[>] 0) (𝓝 (limitEnergy δ)) := by unfold cutoffIntegral cutoffLimit exact tendsto_integral_cutoff_limitDensity hδ theorem tendsto_cutoffEnergy {δ r : ℝ} (hδ : 0 < δ) (hr : 0 < r) {h τ : ℕ → ℝ} (η : (L : ℕ) → GridPairs.Grid L → ℝ) (hh : ∀ᶠ L in atTop, 0 < h L) (hh0 : Tendsto h atTop (𝓝 0)) (hτ0 : Tendsto τ atTop (𝓝 0)) (hη : ∀ᶠ L in atTop, ∀ p, |η L p| ≤ τ L) : Tendsto (fun L => cutoffEnergy L δ (h L) r (η L)) atTop (𝓝 (cutoffIntegral δ r)) := by have hb : Tendsto (fun L => (h L + 2 * τ L) / (δ * r ^ 2)) atTop (𝓝 0) := by simpa only [mul_zero, zero_add, zero_div] using (hh0.add (hτ0.const_mul 2)).div_const (δ * r ^ 2) have he : Tendsto (fun L => ‖cutoffEnergy L δ (h L) r (η L) - gridPairAverage L (cutoffLimit δ r)‖) atTop (𝓝 0) := by apply squeeze_zero' (Eventually.of_forall fun L => norm_nonneg _) _ hb filter_upwards [hh, hη, eventually_gt_atTop 0] with L hLh hLη hL simpa only [Real.norm_eq_abs] using cutoffEnergy_error hL hδ hLh hr hLη have hd := tendsto_zero_iff_norm_tendsto_zero.mpr he simpa only [sub_add_cancel, zero_add] using hd.add (tendsto_grid_cutoff hδ hr) def boundary (L : ℕ) : ℝ := (1 + Real.log (L : ℝ)) / L theorem tendsto_boundary : Tendsto boundary atTop (𝓝 0) := by have hl := (isLittleO_log_rpow_rpow_atTop 1 (by norm_num : (0 : ℝ) < 1)).tendsto_div_nhds_zero have hi : Tendsto (fun x : ℝ => x⁻¹) atTop (𝓝 0) := tendsto_inv_atTop_zero have hb : Tendsto (fun x : ℝ => (1 + Real.log x) / x) atTop (𝓝 0) := by simpa only [Real.rpow_one, add_div, one_div, zero_add] using hi.add hl exact hb.comp tendsto_natCast_atTop_atTop /-- This form is continuous even at zero and equals the genuine strip bound for positive radii. -/ def stripTail (δ r : ℝ) : ℝ := 20 * (1 + δ⁻¹) * (2 * r + |(2 * r) * Real.log (2 * r)|) theorem tendsto_stripTail (δ : ℝ) : Tendsto (stripTail δ) (𝓝[>] 0) (𝓝 0) := by unfold stripTail have hc : Continuous (fun r : ℝ => 20 * (1 + δ⁻¹) * (2 * r + |(2 * r) * Real.log (2 * r)|)) := continuous_const.mul ((continuous_const.mul continuous_id).add (Real.continuous_mul_log.comp (continuous_const.mul continuous_id)).abs) have ht := (hc.tendsto (0 : ℝ)).mono_left (nhdsWithin_le_nhds (s := Ioi (0 : ℝ))) simpa only [stripTail, mul_zero, Real.log_zero, abs_zero, zero_add] using ht def remainder (δ : ℝ) (h : ℕ → ℝ) (L : ℕ) : ℝ := 1 / ((L : ℝ) ^ 2 * h L) + 20 * (1 + δ⁻¹) * boundary L theorem tendsto_remainder (δ : ℝ) {h : ℕ → ℝ} (hg : Tendsto (fun L : ℕ => (L : ℝ) ^ 2 * h L) atTop atTop) : Tendsto (remainder δ h) atTop (𝓝 0) := by have hd := tendsto_inv_atTop_zero.comp hg unfold remainder simpa only [Function.comp_def, one_div, mul_zero, zero_add] using hd.add (tendsto_boundary.const_mul (20 * (1 + δ⁻¹))) theorem energy_remainder_le {L : ℕ} (hL : 0 < L) {δ r : ℝ} {h : ℕ → ℝ} (hδ : 0 < δ) (hh : 0 < h L) (hr : 0 < r) (hr1 : r ≤ 1 / 2) (η : GridPairs.Grid L → ℝ) : energy L δ (h L) η - cutoffEnergy L δ (h L) r η ≤ remainder δ h L + stripTail δ r := by apply (energy_sub_cutoff_le_explicit hL hδ hh hr hr1 η).trans_eq unfold remainder stripTail boundary rw [abs_mul, abs_of_pos (show 0 < 2 * r by positivity)] ring /-- No assumption `L*h → ∞` appears. The diagonal condition is exactly `L²*h → ∞`. -/ theorem tendsto_energy {δ : ℝ} (hδ : 0 < δ) {h τ : ℕ → ℝ} (η : (L : ℕ) → GridPairs.Grid L → ℝ) (hh : ∀ᶠ L in atTop, 0 < h L) (hh0 : Tendsto h atTop (𝓝 0)) (hg : Tendsto (fun L : ℕ => (L : ℝ) ^ 2 * h L) atTop atTop) (hτ0 : Tendsto τ atTop (𝓝 0)) (hη : ∀ᶠ L in atTop, ∀ p, |η L p| ≤ τ L) : Tendsto (fun L => energy L δ (h L) (η L)) atTop (𝓝 (limitEnergy δ)) := by rw [Metric.tendsto_nhds] intro ε hε have he : 0 < ε / 4 := by positivity have hc := (Metric.tendsto_nhds.mp (tendsto_cutoffIntegral hδ)) (ε / 4) he have ht := (tendsto_stripTail δ).eventually (gt_mem_nhds he) have hrange : ∀ᶠ r : ℝ in 𝓝[>] 0, r < 1 / 2 := (show ∀ᶠ r : ℝ in 𝓝 0, r < 1 / 2 from gt_mem_nhds (by norm_num : (0 : ℝ) < 1 / 2)).filter_mono nhdsWithin_le_nhds have hpos : ∀ᶠ r : ℝ in 𝓝[>] 0, 0 < r := self_mem_nhdsWithin obtain ⟨r, hr, hr1, hcr, htr⟩ := (hpos.and (hrange.and (hc.and ht))).exists have hcut := (Metric.tendsto_nhds.mp (tendsto_cutoffEnergy hδ hr η hh hh0 hτ0 hη)) (ε / 4) he have hrem := (tendsto_remainder δ hg).eventually (gt_mem_nhds he) filter_upwards [hh, eventually_gt_atTop 0, hcut, hrem] with L hLh hL hcL hrL have hn := energy_sub_cutoff_nonneg L hδ hLh r (η L) have hb := energy_remainder_le hL hδ hLh hr hr1.le (η L) have htri := abs_sub_le (energy L δ (h L) (η L)) (cutoffEnergy L δ (h L) r (η L)) (limitEnergy δ) have htri' := abs_sub_le (cutoffEnergy L δ (h L) r (η L)) (cutoffIntegral δ r) (limitEnergy δ) rw [abs_of_nonneg hn] at htri rw [Real.dist_eq] at hcL hcr ⊢ linarith theorem tendsto_energy_reference {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) {h τ : ℕ → ℝ} (η : (L : ℕ) → GridPairs.Grid L → ℝ) (hh : ∀ᶠ L in atTop, 0 < h L) (hh0 : Tendsto h atTop (𝓝 0)) (hg : Tendsto (fun L : ℕ => (L : ℝ) ^ 2 * h L) atTop atTop) (hτ0 : Tendsto τ atTop (𝓝 0)) (hη : ∀ᶠ L in atTop, ∀ p, |η L p| ≤ τ L) : Tendsto (fun L => energy L δ (h L) (η L)) atTop (𝓝 (∫ a, referenceEnergy δ a ∂parameterMeasure δ)) := by rw [← limitEnergy_eq_referenceEnergy hδ hδ1] exact tendsto_energy hδ η hh hh0 hg hτ0 hη end DistanceCounts.MesoscopicEnergy end end BodyFile070 -- Source: DistanceCounts/ProjectionCrossTerm.lean section BodyFile071 noncomputable section open Set MeasureTheory Filter namespace DistanceCounts.ProjectionCrossTerm open ProjectionDensity ParameterKernel GridQuadrature ContinuumEnergy EmpiricalEnergy /-- Fixed, deterministic perturbations of the genuine projected grid. -/ def centers (L : ℕ) (δ : ℝ) (η : GridPairs.Grid L → ℝ) (a : ℝ × ℝ) (p : GridPairs.Grid L) : ℝ := projection δ (sample L p).1 (sample L p).2 a + η p /-- The actual mixed Lebesgue integral, averaged over the parameter law. -/ def crossTerm (L : ℕ) (δ h : ℝ) (η : GridPairs.Grid L → ℝ) : ℝ := ∫ a, ∫ t, smoothed (centers L δ η a) h t * density (1 - δ + a.1) (1 + a.2) t ∂volume ∂parameterMeasure δ /-- Joint measurability is global, including parameters outside the probability support. -/ lemma measurable_cross_integrand (L : ℕ) (δ h : ℝ) (η : GridPairs.Grid L → ℝ) : Measurable (fun x : (ℝ × ℝ) × ℝ => smoothed (centers L δ η x.1) h x.2 * density (1 - δ + x.1.1) (1 + x.1.2) x.2) := by apply Measurable.mul · unfold smoothed apply Measurable.mul measurable_const apply Finset.measurable_sum intro p hp apply (measurable_box h).comp unfold centers projection fun_prop · unfold density fun_prop lemma measurable_reference_integrand (δ : ℝ) : Measurable (fun x : (ℝ × ℝ) × ℝ => density (1 - δ + x.1.1) (1 + x.1.2) x.2 ^ 2) := by unfold density fun_prop lemma integrable_cross_section (L : ℕ) (δ : ℝ) {h : ℝ} (hh : 0 < h) (η : GridPairs.Grid L → ℝ) (a : ℝ × ℝ) : Integrable (fun t => smoothed (centers L δ η a) h t * density (1 - δ + a.1) (1 + a.2) t) := integrable_smoothed_test _ (integrable_density _ _) hh lemma cross_section_nonneg (L : ℕ) (δ : ℝ) {h : ℝ} (hh : 0 < h) (η : GridPairs.Grid L → ℝ) {a : ℝ × ℝ} (ha : 0 < 1 - δ + a.1) (hb : 0 < 1 + a.2) : 0 ≤ ∫ t, smoothed (centers L δ η a) h t * density (1 - δ + a.1) (1 + a.2) t := integral_nonneg fun t => mul_nonneg (smoothed_nonneg _ hh t) (density_nonneg ha hb t) lemma cross_section_le {L : ℕ} (hL : 0 < L) (δ : ℝ) {h : ℝ} (hh : 0 < h) (η : GridPairs.Grid L → ℝ) {a : ℝ × ℝ} (ha : 0 < 1 - δ + a.1) (hb : 0 < 1 + a.2) : (∫ t, smoothed (centers L δ η a) h t * density (1 - δ + a.1) (1 + a.2) t) ≤ 1 / (1 - δ + a.1) := by letI : Nonempty (Fin L) := ⟨⟨0, hL⟩⟩ calc _ ≤ ∫ t, smoothed (centers L δ η a) h t * (1 / (1 - δ + a.1)) := integral_mono (integrable_cross_section L δ hh η a) ((integrable_smoothed _ h).mul_const _) (fun t => mul_le_mul_of_nonneg_left (density_le ha hb t) (smoothed_nonneg _ hh t)) _ = _ := by rw [integral_mul_const, integral_smoothed _ hh, one_mul] /-- All parameter integrals below are genuine integrable functions, not default-zero integrals. -/ theorem integrable_cross_outer {L : ℕ} (hL : 0 < L) {δ h : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (hh : 0 < h) (η : GridPairs.Grid L → ℝ) : Integrable (fun a => ∫ t, smoothed (centers L δ η a) h t * density (1 - δ + a.1) (1 + a.2) t) (parameterMeasure δ) := by letI := parameterMeasure_probability hδ apply Integrable.of_bound (measurable_cross_integrand L δ h η).stronglyMeasurable.integral_prod_right'.aestronglyMeasurable (1 / (1 - δ)) filter_upwards [ProjectionContinuumLimit.ae_parameter_support hδ] with a ha have hα : 0 < 1 - δ + a.1 := by linarith [ha.1.1] have hβ : 0 < 1 + a.2 := by linarith [ha.2.1] rw [Real.norm_eq_abs, abs_of_nonneg (cross_section_nonneg L δ hh η hα hβ)] exact (cross_section_le hL δ hh η hα hβ).trans (one_div_le_one_div_of_le (by linarith) (by linarith [ha.1.1])) theorem integrable_reference_outer {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) : Integrable (fun a : ℝ × ℝ => ∫ t, density (1 - δ + a.1) (1 + a.2) t ^ 2) (parameterMeasure δ) := by letI := parameterMeasure_probability hδ apply Integrable.of_bound (measurable_reference_integrand δ).stronglyMeasurable.integral_prod_right'.aestronglyMeasurable (1 / (1 - δ)) filter_upwards [ProjectionContinuumLimit.ae_parameter_support hδ] with a ha have hα : 0 < 1 - δ + a.1 := by linarith [ha.1.1] have hβ : 0 < 1 + a.2 := by linarith [ha.2.1] rw [Real.norm_eq_abs, abs_of_nonneg (integral_nonneg fun t => sq_nonneg _)] exact (integral_density_sq_le hα hβ).trans (one_div_le_one_div_of_le (by linarith) (by linarith [ha.1.1])) lemma lipschitz_dot_three {a b : ℝ} (ha : 0 < a) (hb : 0 < b) (ha1 : a ≤ 1) (hb2 : b ≤ 2) : LipschitzWith 3 (dot a b) := by apply lipschitzWith_iff_dist_le_mul.mpr intro u v have hu : |u.1 - v.1| ≤ dist u v := by rw [← Real.dist_eq, Prod.dist_eq] exact le_max_left _ _ have hv : |u.2 - v.2| ≤ dist u v := by rw [← Real.dist_eq, Prod.dist_eq] exact le_max_right _ _ rw [Real.dist_eq] change |dot a b u - dot a b v| ≤ 3 * dist u v calc _ = |a * (u.1 - v.1) + b * (u.2 - v.2)| := by congr 1; unfold dot; ring _ ≤ |a * (u.1 - v.1)| + |b * (u.2 - v.2)| := abs_add_le _ _ _ = a * |u.1 - v.1| + b * |u.2 - v.2| := by rw [abs_mul, abs_mul, abs_of_pos ha, abs_of_pos hb] _ ≤ a * dist u v + b * dist u v := add_le_add (mul_le_mul_of_nonneg_left hu ha.le) (mul_le_mul_of_nonneg_left hv hb.le) _ ≤ 3 * dist u v := by nlinarith [show 0 ≤ dist u v from dist_nonneg] /-- Smoothing, deterministic displacement, and square quadrature are controlled separately. -/ theorem section_error {L : ℕ} (hL : 0 < L) {a b h τ : ℝ} (ha : 0 < a) (hb : 0 < b) (ha1 : a ≤ 1) (hb2 : b ≤ 2) (hh : 0 < h) (η : GridPairs.Grid L → ℝ) (hη : ∀ p, |η p| ≤ τ) : |(∫ t, smoothed (fun p => dot a b (sample L p) + η p) h t * density a b t) - ∫ t, density a b t ^ 2| ≤ (h + τ + 3 / (L : ℝ)) / (a * b) := by classical letI : Nonempty (Fin L) := ⟨⟨0, hL⟩⟩ let z : GridPairs.Grid L → ℝ := fun p => dot a b (sample L p) + η p let N : ℝ := Fintype.card (GridPairs.Grid L) have hN : N ≠ 0 := by dsimp [N] exact_mod_cast (Fintype.card_pos_iff.mpr (inferInstance : Nonempty (GridPairs.Grid L))).ne' have hcard : N = (L : ℝ) ^ 2 := by simp [N, GridPairs.Grid, pow_two] have hs := integral_smoothed_test_error z (integrable_density a b) (lipschitzWith_density ha hb) hh have hj : |N⁻¹ * ∑ p, density a b (z p) - N⁻¹ * ∑ p : GridPairs.Grid L, density a b (dot a b (sample L p))| ≤ τ / (a * b) := by rw [← mul_sub, ← Finset.sum_sub_distrib, abs_mul, abs_of_nonneg (show 0 ≤ N⁻¹ by dsimp [N]; positivity)] calc _ ≤ N⁻¹ * ∑ p, |density a b (z p) - density a b (dot a b (sample L p))| := mul_le_mul_of_nonneg_left (Finset.abs_sum_le_sum_abs _ _) (by dsimp [N]; positivity) _ ≤ N⁻¹ * ∑ _p : GridPairs.Grid L, τ / (a * b) := by apply mul_le_mul_of_nonneg_left _ (by dsimp [N]; positivity) apply Finset.sum_le_sum intro p hp exact (density_abs_sub_le ha hb _ _).trans (div_le_div_of_nonneg_right (by simpa [z] using hη p) (mul_pos ha hb).le) _ = _ := by simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] change N⁻¹ * (N * (τ / (a * b))) = _ rw [← mul_assoc, inv_mul_cancel₀ hN, one_mul] have hg := gridAverage_lipschitz_error L hL ((lipschitzWith_density ha hb).comp (lipschitz_dot_three ha hb ha1 hb2)) have hid : (∫ u, density a b (dot a b u) ∂parameterMeasure 1) = ∫ t, density a b t ^ 2 := by simpa only [pow_two] using integral_dot ha hb (continuous_density a b) (fun t => by rw [Real.norm_eq_abs, abs_of_nonneg (density_nonneg ha hb t)] exact density_le ha hb t) have hav : N⁻¹ * ∑ p : GridPairs.Grid L, density a b (dot a b (sample L p)) = gridAverage L (fun u => density a b (dot a b u)) := by rw [hcard] simp only [gridAverage, div_eq_mul_inv, mul_comm] change |gridAverage L (fun u => density a b (dot a b u)) - ∫ u, density a b (dot a b u) ∂parameterMeasure 1| ≤ _ at hg rw [hid] at hg calc _ ≤ |(∫ t, smoothed z h t * density a b t) - N⁻¹ * ∑ p, density a b (z p)| + |N⁻¹ * ∑ p, density a b (z p) - ∫ t, density a b t ^ 2| := abs_sub_le _ _ _ _ ≤ (a * b)⁻¹ * h + (|N⁻¹ * ∑ p, density a b (z p) - N⁻¹ * ∑ p : GridPairs.Grid L, density a b (dot a b (sample L p))| + |N⁻¹ * ∑ p : GridPairs.Grid L, density a b (dot a b (sample L p)) - ∫ t, density a b t ^ 2|) := add_le_add hs (abs_sub_le _ _ _) _ ≤ (a * b)⁻¹ * h + (τ / (a * b) + ((a * b)⁻¹ * 3) / (L : ℝ)) := by apply add_le_add (le_refl _) apply add_le_add hj rw [hav] simpa using hg _ = _ := by ring /-- Uniform averaged cross-term error. No density-law or quadrature premise is required. -/ theorem crossTerm_error {L : ℕ} (hL : 0 < L) {δ h τ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (hh : 0 < h) (η : GridPairs.Grid L → ℝ) (hη : ∀ p, |η p| ≤ τ) : |crossTerm L δ h η - ∫ a : ℝ × ℝ, ∫ t, density (1 - δ + a.1) (1 + a.2) t ^ 2 ∂volume ∂parameterMeasure δ| ≤ (h + τ + 3 / (L : ℝ)) / (1 - δ) := by letI := parameterMeasure_probability hδ have hτ : 0 ≤ τ := (abs_nonneg (η (⟨0, hL⟩, ⟨0, hL⟩))).trans (hη _) have hC : 0 ≤ h + τ + 3 / (L : ℝ) := by positivity unfold crossTerm rw [← integral_sub (integrable_cross_outer hL hδ hδ1 hh η) (integrable_reference_outer hδ hδ1), ← Real.norm_eq_abs] have he : ∀ᵐ a ∂parameterMeasure δ, ‖(∫ t, smoothed (centers L δ η a) h t * density (1 - δ + a.1) (1 + a.2) t) - ∫ t, density (1 - δ + a.1) (1 + a.2) t ^ 2‖ ≤ (h + τ + 3 / (L : ℝ)) / (1 - δ) := by filter_upwards [ProjectionContinuumLimit.ae_parameter_support hδ] with a ha have hα : 0 < 1 - δ + a.1 := by linarith [ha.1.1] have hβ : 0 < 1 + a.2 := by linarith [ha.2.1] have hprod : 1 - δ ≤ (1 - δ + a.1) * (1 + a.2) := by nlinarith [ha.1.1, ha.2.1, mul_nonneg hα.le ha.2.1] rw [Real.norm_eq_abs] have hs := section_error hL hα hβ (by linarith [ha.1.2]) (by linarith [ha.2.2]) hh η hη change |(∫ t, smoothed (centers L δ η a) h t * density (1 - δ + a.1) (1 + a.2) t) - ∫ t, density (1 - δ + a.1) (1 + a.2) t ^ 2| ≤ _ at hs exact hs.trans (div_le_div_of_nonneg_left hC (by linarith) hprod) simpa using norm_integral_le_of_norm_le_const he end DistanceCounts.ProjectionCrossTerm end end BodyFile071 -- Source: DistanceCounts/MesoscopicProjection.lean section BodyFile072 /-! Expected Lebesgue L² convergence of the actual perturbed grid projection. -/ noncomputable section namespace DistanceCounts.MesoscopicProjection open Filter MeasureTheory Set open ParameterKernel EmpiricalEnergy EmpiricalPairKernel ProjectionDensity open ProjectionContinuumLimit open scoped Topology def squareError (L : ℕ) (δ h : ℝ) (η : GridPairs.Grid L → ℝ) (a : ℝ × ℝ) : ℝ := ∫ t : ℝ, (smoothed (center L δ η a) h t - density (1 - δ + a.1) (1 + a.2) t) ^ 2 def expectedSquareError (L : ℕ) (δ h : ℝ) (η : GridPairs.Grid L → ℝ) : ℝ := ∫ a, squareError L δ h η a ∂parameterMeasure δ theorem squareError_nonneg (L : ℕ) (δ h : ℝ) (η : GridPairs.Grid L → ℝ) (a : ℝ × ℝ) : 0 ≤ squareError L δ h η a := integral_nonneg fun _ => sq_nonneg _ theorem expectedSquareError_nonneg (L : ℕ) (δ h : ℝ) (η : GridPairs.Grid L → ℝ) : 0 ≤ expectedSquareError L δ h η := integral_nonneg (squareError_nonneg L δ h η) theorem measurable_smoothed_joint (L : ℕ) (δ h : ℝ) (η : GridPairs.Grid L → ℝ) : Measurable (fun x : (ℝ × ℝ) × ℝ => smoothed (center L δ η x.1) h x.2) := by unfold smoothed apply Measurable.mul measurable_const apply Finset.measurable_sum intro p hp apply (measurable_box h).comp unfold EmpiricalPairKernel.center projection fun_prop theorem self_energy_le {L : ℕ} (hL : 0 < L) {h : ℝ} (hh : 0 < h) (z : GridPairs.Grid L → ℝ) : (∫ t, smoothed z h t ^ 2) ≤ 1 / h := by let N : ℝ := Fintype.card (GridPairs.Grid L) have hLr : (0 : ℝ) < L := by exact_mod_cast hL have hN : N ≠ 0 := by dsimp [N] simp only [GridPairs.Grid, Fintype.card_prod, Fintype.card_fin, Nat.cast_mul] positivity rw [integral_smoothed_sq z hh] calc _ ≤ N⁻¹ ^ 2 * ∑ i : GridPairs.Grid L, ∑ j : GridPairs.Grid L, (1 / h) := by apply mul_le_mul_of_nonneg_left _ (sq_nonneg _) exact Finset.sum_le_sum fun i _ => Finset.sum_le_sum fun j _ => by simpa only [one_div] using kernel_le hh (z i - z j) _ = _ := by simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] change N⁻¹ ^ 2 * (N * (N * (1 / h))) = 1 / h field_simp [hN] <;> ring theorem integrable_self_outer {L : ℕ} (hL : 0 < L) {δ h : ℝ} (hδ : 0 < δ) (hh : 0 < h) (η : GridPairs.Grid L → ℝ) : Integrable (fun a => ∫ t, smoothed (center L δ η a) h t ^ 2) (parameterMeasure δ) := by letI := parameterMeasure_probability hδ have hm : Measurable (fun a : ℝ × ℝ => ∫ t : ℝ, smoothed (center L δ η a) h t ^ 2) := ((measurable_smoothed_joint L δ h η).pow_const 2).stronglyMeasurable.integral_prod_right'.measurable apply Integrable.of_bound (μ := parameterMeasure δ) hm.aestronglyMeasurable (1 / h) apply ae_of_all intro a change ‖(∫ t : ℝ, smoothed (center L δ η a) h t ^ 2)‖ ≤ 1 / h have hn : 0 ≤ (∫ t : ℝ, smoothed (center L δ η a) h t ^ 2) := integral_nonneg fun _ => sq_nonneg _ calc _ = ∫ t : ℝ, smoothed (center L δ η a) h t ^ 2 := by rw [Real.norm_eq_abs, abs_of_nonneg hn] _ ≤ _ := self_energy_le hL hh _ theorem ae_squareError_eq {L : ℕ} {δ h : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (hh : 0 < h) (η : GridPairs.Grid L → ℝ) : ∀ᵐ a ∂parameterMeasure δ, squareError L δ h η a = (∫ t, smoothed (center L δ η a) h t ^ 2) - 2 * (∫ t, smoothed (center L δ η a) h t * density (1 - δ + a.1) (1 + a.2) t) + referenceEnergy δ a := by filter_upwards [ae_parameter_support hδ] with a ha have hα : 0 < 1 - δ + a.1 := by linarith [ha.1.1] have hβ : 0 < 1 + a.2 := by linarith [ha.2.1] have hs := integrable_smoothed_sq (center L δ η a) h have hc : Integrable (fun t => smoothed (center L δ η a) h t * density (1 - δ + a.1) (1 + a.2) t) := ProjectionCrossTerm.integrable_cross_section L δ hh η a have hf := ContinuumEnergy.integrable_density_sq hα hβ unfold squareError referenceEnergy calc _ = ∫ t, (smoothed (center L δ η a) h t ^ 2 - 2 * (smoothed (center L δ η a) h t * density (1 - δ + a.1) (1 + a.2) t) + density (1 - δ + a.1) (1 + a.2) t ^ 2) := by apply integral_congr_ae exact ae_of_all _ fun _ => by ring _ = _ := by rw [← integral_const_mul (2 : ℝ), ← integral_sub hs (hc.const_mul 2)] exact integral_add (hs.sub (hc.const_mul 2)) hf theorem integrable_squareError {L : ℕ} (hL : 0 < L) {δ h : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (hh : 0 < h) (η : GridPairs.Grid L → ℝ) : Integrable (squareError L δ h η) (parameterMeasure δ) := by have hs := integrable_self_outer hL hδ hh η have hc : Integrable (fun a => ∫ t, smoothed (center L δ η a) h t * density (1 - δ + a.1) (1 + a.2) t) (parameterMeasure δ) := ProjectionCrossTerm.integrable_cross_outer hL hδ hδ1 hh η have hf := integrable_referenceEnergy hδ hδ1 exact ((hs.sub (hc.const_mul 2)).add hf).congr (Filter.EventuallyEq.symm (ae_squareError_eq hδ hδ1 hh η)) theorem expectedSquareError_eq {L : ℕ} (hL : 0 < L) {δ h : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (hh : 0 < h) (η : GridPairs.Grid L → ℝ) : expectedSquareError L δ h η = energy L δ h η - 2 * ProjectionCrossTerm.crossTerm L δ h η + ∫ a, referenceEnergy δ a ∂parameterMeasure δ := by have hs := integrable_self_outer hL hδ hh η have hc : Integrable (fun a => ∫ t, smoothed (center L δ η a) h t * density (1 - δ + a.1) (1 + a.2) t) (parameterMeasure δ) := ProjectionCrossTerm.integrable_cross_outer hL hδ hδ1 hh η have hf := integrable_referenceEnergy hδ hδ1 unfold expectedSquareError rw [integral_congr_ae (ae_squareError_eq hδ hδ1 hh η), energy_eq_integral_smoothed_sq L hh η] unfold ProjectionCrossTerm.crossTerm rw [show ProjectionCrossTerm.centers L δ η = EmpiricalPairKernel.center L δ η from rfl] rw [← integral_const_mul (2 : ℝ), ← integral_sub hs (hc.const_mul 2)] exact integral_add (hs.sub (hc.const_mul 2)) hf theorem tendsto_crossTerm {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) {h τ : ℕ → ℝ} (η : (L : ℕ) → GridPairs.Grid L → ℝ) (hh : ∀ᶠ L in atTop, 0 < h L) (hh0 : Tendsto h atTop (𝓝 0)) (hτ0 : Tendsto τ atTop (𝓝 0)) (hη : ∀ᶠ L in atTop, ∀ p, |η L p| ≤ τ L) : Tendsto (fun L => ProjectionCrossTerm.crossTerm L δ (h L) (η L)) atTop (𝓝 (∫ a, referenceEnergy δ a ∂parameterMeasure δ)) := by apply tendsto_iff_norm_sub_tendsto_zero.mpr have hi : Tendsto (fun L : ℕ => (L : ℝ)⁻¹) atTop (𝓝 0) := tendsto_inv_atTop_zero.comp tendsto_natCast_atTop_atTop have hb : Tendsto (fun L => (h L + τ L + 3 / (L : ℝ)) / (1 - δ)) atTop (𝓝 0) := by simpa only [div_eq_mul_inv, mul_zero, zero_mul, zero_add] using ((hh0.add hτ0).add (hi.const_mul 3)).div_const (1 - δ) apply squeeze_zero' (Eventually.of_forall fun _ => norm_nonneg _) _ hb filter_upwards [hh, hη, eventually_gt_atTop 0] with L hLh hLη hL simpa only [Real.norm_eq_abs, referenceEnergy] using ProjectionCrossTerm.crossTerm_error hL hδ hδ1 hLh (η L) hLη /-- Actual expected squared error tends to zero at every mesoscopic bandwidth. -/ theorem tendsto_expectedSquareError {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) {h τ : ℕ → ℝ} (η : (L : ℕ) → GridPairs.Grid L → ℝ) (hh : ∀ᶠ L in atTop, 0 < h L) (hh0 : Tendsto h atTop (𝓝 0)) (hg : Tendsto (fun L : ℕ => (L : ℝ) ^ 2 * h L) atTop atTop) (hτ0 : Tendsto τ atTop (𝓝 0)) (hη : ∀ᶠ L in atTop, ∀ p, |η L p| ≤ τ L) : Tendsto (fun L => expectedSquareError L δ (h L) (η L)) atTop (𝓝 0) := by have hs := MesoscopicEnergy.tendsto_energy_reference hδ hδ1 η hh hh0 hg hτ0 hη have hc := tendsto_crossTerm hδ hδ1 η hh hh0 hτ0 hη have hf : Tendsto (fun _ : ℕ => ∫ a, referenceEnergy δ a ∂parameterMeasure δ) atTop (𝓝 (∫ a, referenceEnergy δ a ∂parameterMeasure δ)) := tendsto_const_nhds have hsum := (hs.sub (hc.const_mul 2)).add hf have hz : (∫ a, referenceEnergy δ a ∂parameterMeasure δ) - 2 * (∫ a, referenceEnergy δ a ∂parameterMeasure δ) + (∫ a, referenceEnergy δ a ∂parameterMeasure δ) = 0 := by ring rw [hz] at hsum apply hsum.congr' filter_upwards [hh, eventually_gt_atTop 0] with L hLh hL exact (expectedSquareError_eq hL hδ hδ1 hLh (η L)).symm end DistanceCounts.MesoscopicProjection end end BodyFile072 -- Source: DistanceCounts/FineData.lean section BodyFile073 /-! Parameter-independent perturbations determined by the original pinned counts. -/ noncomputable section namespace DistanceCounts.FineData /-- The actual residual from the assigned coarse degree. -/ def error {K L : ℕ} (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (i : Fin K × GridPairs.Grid L) : ℝ := (Z0 i : ℝ) - (D i.1 : ℝ) * (L : ℝ) ^ 2 /-- Include the exact integer-jitter unit-cell shift, which is deterministic as well. -/ def perturbation {K L : ℕ} (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (H : ℕ) (b : Fin K) (p : GridPairs.Grid L) : ℝ := error D Z0 (b, p) / (L : ℝ) ^ 2 - (H : ℝ) / (L : ℝ) ^ 2 + 1 / (L : ℝ) ^ 2 theorem decomposition {K L : ℕ} (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (i : Fin K × GridPairs.Grid L) : (Z0 i : ℝ) = (D i.1 : ℝ) * (L : ℝ) ^ 2 + error D Z0 i := by unfold error ring end DistanceCounts.FineData end end BodyFile073 -- Source: DistanceCounts/ConstructionScales.lean section BodyFile074 noncomputable section open Filter open scoped Topology namespace DistanceCounts.ConstructionScales /-- The schedules are literal floors, including at the early scales where they vanish. -/ def N (K L : ℕ) : ℕ := K * L ^ 2 def H (L : ℕ) : ℕ := ⌊Real.sqrt (L : ℝ)⌋₊ def B (K L : ℕ) : ℕ := ⌊Real.sqrt (Real.log (N K L : ℝ))⌋₊ def ell (K L : ℕ) : ℕ := ⌊Real.log (N K L : ℝ) / (2 * Real.log 2)⌋₊ def h (L : ℕ) : ℝ := (H L : ℝ) / (L : ℝ) ^ 2 def E (L : ℕ) : ℝ := (L : ℝ) ^ (1 / 10 : ℝ) def rowCost (K L : ℕ) : ℕ := 2 * K * H L * L def unaryCost (K L : ℕ) : ℕ := 2 * B K L * (ell K L * 2 ^ ell K L + K * (L ^ 2 / ell K L + 1)) private lemma tendsto_L : Tendsto (fun L : ℕ => (L : ℝ)) atTop atTop := tendsto_natCast_atTop_atTop private lemma eventually_L_pos : ∀ᶠ L : ℕ in atTop, (0 : ℝ) < L := tendsto_L.eventually (eventually_gt_atTop 0) lemma tendsto_N {K : ℕ} (hK : 0 < K) : Tendsto (fun L : ℕ => (N K L : ℝ)) atTop atTop := by simpa [N] using ((tendsto_pow_atTop (by decide : 2 ≠ 0)).comp tendsto_L).const_mul_atTop (show (0 : ℝ) < K by exact_mod_cast hK) lemma tendsto_logN {K : ℕ} (hK : 0 < K) : Tendsto (fun L : ℕ => Real.log (N K L : ℝ)) atTop atTop := Real.tendsto_log_atTop.comp (tendsto_N hK) private lemma tendsto_sqrtL : Tendsto (fun L : ℕ => Real.sqrt (L : ℝ)) atTop atTop := by simpa only [Function.comp_def, Real.sqrt_eq_rpow] using (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 2)).comp tendsto_L private lemma tendsto_sqrtLogN {K : ℕ} (hK : 0 < K) : Tendsto (fun L : ℕ => Real.sqrt (Real.log (N K L : ℝ))) atTop atTop := by simpa only [Function.comp_def, Real.sqrt_eq_rpow] using (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 2)).comp (tendsto_logN hK) private lemma log_two_pos : 0 < Real.log 2 := Real.log_pos (by norm_num) private lemma tendsto_ellReal {K : ℕ} (hK : 0 < K) : Tendsto (fun L : ℕ => Real.log (N K L : ℝ) / (2 * Real.log 2)) atTop atTop := (tendsto_logN hK).atTop_div_const (by positivity) lemma tendsto_H : Tendsto H atTop atTop := tendsto_nat_floor_atTop.comp tendsto_sqrtL lemma tendsto_B {K : ℕ} (hK : 0 < K) : Tendsto (B K) atTop atTop := tendsto_nat_floor_atTop.comp (tendsto_sqrtLogN hK) lemma tendsto_ell {K : ℕ} (hK : 0 < K) : Tendsto (ell K) atTop atTop := tendsto_nat_floor_atTop.comp (tendsto_ellReal hK) lemma eventually_pos {K : ℕ} (hK : 0 < K) : ∀ᶠ L : ℕ in atTop, 0 < H L ∧ 0 < B K L ∧ 0 < ell K L := by filter_upwards [tendsto_H.eventually (eventually_gt_atTop 0), (tendsto_B hK).eventually (eventually_gt_atTop 0), (tendsto_ell hK).eventually (eventually_gt_atTop 0)] with L hH hB he exact ⟨hH, hB, he⟩ lemma tendsto_H_div_sqrt : Tendsto (fun L : ℕ => (H L : ℝ) / Real.sqrt L) atTop (𝓝 1) := tendsto_nat_floor_div_atTop.comp tendsto_sqrtL private lemma tendsto_rpow_ratio (a b : ℝ) (hab : a < b) : Tendsto (fun L : ℕ => (L : ℝ) ^ a / (L : ℝ) ^ b) atTop (𝓝 0) := by have ht := (tendsto_rpow_neg_atTop (sub_pos.mpr hab)).comp tendsto_L apply ht.congr' filter_upwards [eventually_L_pos] with L hL change (L : ℝ) ^ (-(b - a)) = (L : ℝ) ^ a / (L : ℝ) ^ b rw [show -(b - a) = a - b by ring, Real.rpow_sub hL] lemma tendsto_H_div_L : Tendsto (fun L : ℕ => (H L : ℝ) / L) atTop (𝓝 0) := by have ht := tendsto_H_div_sqrt.mul (tendsto_rpow_ratio (1 / 2) 1 (by norm_num)) simp only [mul_zero, Real.rpow_one] at ht apply ht.congr' filter_upwards [eventually_L_pos] with L hL rw [← Real.sqrt_eq_rpow] field_simp [Real.sqrt_ne_zero'.mpr hL] lemma tendsto_h : Tendsto h atTop (𝓝 0) := by have ht := tendsto_H_div_L.mul (tendsto_L.inv_tendsto_atTop) simp only [mul_zero] at ht apply ht.congr' filter_upwards [eventually_L_pos] with L hL change (H L : ℝ) / (L : ℝ) * (L : ℝ)⁻¹ = (H L : ℝ) / (L : ℝ) ^ 2 field_simp lemma tendsto_square_mul_h : Tendsto (fun L : ℕ => (L : ℝ) ^ 2 * h L) atTop atTop := by apply (tendsto_natCast_atTop_atTop.comp tendsto_H).congr' filter_upwards [eventually_L_pos] with L hL dsimp [h] field_simp lemma tendsto_E_div_sqrt : Tendsto (fun L : ℕ => E L / Real.sqrt L) atTop (𝓝 0) := by simpa [E, Real.sqrt_eq_rpow] using tendsto_rpow_ratio (1 / 10) (1 / 2) (by norm_num) lemma tendsto_discrepancy_div_H : Tendsto (fun L : ℕ => (2 * E L + 1) / (H L : ℝ)) atTop (𝓝 0) := by have ht := ((tendsto_E_div_sqrt.const_mul 2).add tendsto_sqrtL.inv_tendsto_atTop).div tendsto_H_div_sqrt one_ne_zero simp only [mul_zero, add_zero, zero_div] at ht apply ht.congr' filter_upwards [eventually_L_pos] with L hL change (2 * (E L / Real.sqrt (L : ℝ)) + (Real.sqrt (L : ℝ))⁻¹) / ((H L : ℝ) / Real.sqrt (L : ℝ)) = (2 * E L + 1) / (H L : ℝ) field_simp [Real.sqrt_ne_zero'.mpr hL] <;> ring lemma tendsto_rowCost (K : ℕ) : Tendsto (fun L : ℕ => (rowCost K L : ℝ) / (L : ℝ) ^ 2) atTop (𝓝 0) := by have ht := tendsto_H_div_L.const_mul (2 * (K : ℝ)) simp only [mul_zero] at ht apply ht.congr' filter_upwards [eventually_L_pos] with L hL dsimp [rowCost] push_cast field_simp private lemma logN_eq {K L : ℕ} (hK : 0 < K) (hL : (0 : ℝ) < L) : Real.log (N K L : ℝ) = Real.log (K : ℝ) + 2 * Real.log L := by have hKr : (K : ℝ) ≠ 0 := by exact_mod_cast hK.ne' simp [N, Real.log_mul hKr (pow_ne_zero _ hL.ne'), Real.log_pow] lemma tendsto_logN_div_rpow {K : ℕ} (hK : 0 < K) {r : ℝ} (hr : 0 < r) : Tendsto (fun L : ℕ => Real.log (N K L : ℝ) / (L : ℝ) ^ r) atTop (𝓝 0) := by have hlog : Tendsto (fun L : ℕ => Real.log (L : ℝ) / (L : ℝ) ^ r) atTop (𝓝 0) := by simpa only [Function.comp_def] using (isLittleO_log_rpow_atTop hr).tendsto_div_nhds_zero.comp tendsto_L have hconst := (tendsto_const_nhds (x := Real.log (K : ℝ))).div_atTop ((tendsto_rpow_atTop hr).comp tendsto_L) have ht := hconst.add (hlog.const_mul 2) simp only [mul_zero, add_zero] at ht apply ht.congr' filter_upwards [eventually_L_pos] with L hL change Real.log (K : ℝ) / (L : ℝ) ^ r + 2 * (Real.log (L : ℝ) / (L : ℝ) ^ r) = Real.log (N K L : ℝ) / (L : ℝ) ^ r rw [logN_eq hK hL] ring lemma eventually_B_le_logN {K : ℕ} (hK : 0 < K) : ∀ᶠ L : ℕ in atTop, (B K L : ℝ) ≤ Real.log (N K L : ℝ) := by filter_upwards [(tendsto_logN hK).eventually (eventually_ge_atTop 1)] with L hL apply (Nat.floor_le (Real.sqrt_nonneg _)).trans have hs := Real.sq_sqrt (show 0 ≤ Real.log (N K L : ℝ) by linarith) have hp := Real.sqrt_nonneg (Real.log (N K L : ℝ)) nlinarith lemma tendsto_B_div_rpow {K : ℕ} (hK : 0 < K) {r : ℝ} (hr : 0 < r) : Tendsto (fun L : ℕ => (B K L : ℝ) / (L : ℝ) ^ r) atTop (𝓝 0) := by apply squeeze_zero' (Eventually.of_forall (fun L => by positivity)) ((eventually_B_le_logN hK).mono (fun L hL => div_le_div_of_nonneg_right hL (Real.rpow_nonneg (Nat.cast_nonneg L) r))) (tendsto_logN_div_rpow hK hr) lemma tendsto_B_div_ell {K : ℕ} (hK : 0 < K) : Tendsto (fun L : ℕ => (B K L : ℝ) / ell K L) atTop (𝓝 0) := by have hb : Tendsto (fun L : ℕ => (B K L : ℝ) / Real.sqrt (Real.log (N K L : ℝ))) atTop (𝓝 1) := tendsto_nat_floor_div_atTop.comp (tendsto_sqrtLogN hK) have he : Tendsto (fun L : ℕ => (ell K L : ℝ) / (Real.log (N K L : ℝ) / (2 * Real.log 2))) atTop (𝓝 1) := tendsto_nat_floor_div_atTop.comp (tendsto_ellReal hK) have ht := (hb.div he one_ne_zero).mul ((tendsto_sqrtLogN hK).inv_tendsto_atTop.const_mul (2 * Real.log 2)) simp only [one_div_one, mul_zero] at ht apply ht.congr' filter_upwards [(tendsto_logN hK).eventually (eventually_gt_atTop 0), eventually_pos hK] with L hL hp have hs := Real.sq_sqrt hL.le have hs0 := (Real.sqrt_pos.mpr hL).ne' have hc := log_two_pos.ne' have he0 : (ell K L : ℝ) ≠ 0 := by exact_mod_cast hp.2.2.ne' change ((B K L : ℝ) / Real.sqrt (Real.log (N K L : ℝ)) / ((ell K L : ℝ) / (Real.log (N K L : ℝ) / (2 * Real.log 2)))) * (2 * Real.log 2 * (Real.sqrt (Real.log (N K L : ℝ)))⁻¹) = (B K L : ℝ) / (ell K L : ℝ) calc _ = (B K L : ℝ) * Real.log (N K L : ℝ) / ((ell K L : ℝ) * Real.sqrt (Real.log (N K L : ℝ)) ^ 2) := by field_simp [hs0, hc, hL.ne', he0] <;> ring _ = _ := by rw [hs]; field_simp [hL.ne', he0] /-- The integer binary dictionary really fits under the square-root envelope. -/ lemma pow_ell_le_sqrt {K L : ℕ} (hN : 1 ≤ (N K L : ℝ)) : (2 : ℝ) ^ ell K L ≤ Real.sqrt (N K L : ℝ) := by have hn : 0 < (N K L : ℝ) := lt_of_lt_of_le zero_lt_one hN have he : (ell K L : ℝ) ≤ Real.log (N K L : ℝ) / (2 * Real.log 2) := Nat.floor_le (div_nonneg (Real.log_nonneg hN) (by positivity)) rw [← Real.rpow_natCast, Real.rpow_def_of_pos (by norm_num), Real.sqrt_eq_rpow, Real.rpow_def_of_pos hn] apply Real.exp_le_exp.mpr have ht := (le_div_iff₀ (show 0 < 2 * Real.log 2 by positivity)).mp he nlinarith [log_two_pos] private lemma sqrtN_eq (K L : ℕ) : Real.sqrt (N K L : ℝ) = Real.sqrt K * L := by simp [N, Real.sqrt_mul (Nat.cast_nonneg K), Real.sqrt_sq (Nat.cast_nonneg L)] private lemma tendsto_dictionaryCost {K : ℕ} (hK : 0 < K) : Tendsto (fun L : ℕ => (B K L : ℝ) * ell K L * (2 : ℝ) ^ ell K L / (L : ℝ) ^ 2) atTop (𝓝 0) := by have ht := ((tendsto_logN_div_rpow hK (by norm_num : (0 : ℝ) < 1 / 2)).pow 2).const_mul (Real.sqrt K / (2 * Real.log 2)) simp only [zero_pow (by decide : 2 ≠ 0), mul_zero] at ht have ht' : Tendsto (fun L : ℕ => Real.sqrt K / (2 * Real.log 2) * Real.log (N K L : ℝ) ^ 2 / L) atTop (𝓝 0) := by apply ht.congr' filter_upwards [eventually_L_pos] with L hL change Real.sqrt (K : ℝ) / (2 * Real.log 2) * (Real.log (N K L : ℝ) / (L : ℝ) ^ (1 / 2 : ℝ)) ^ 2 = Real.sqrt (K : ℝ) / (2 * Real.log 2) * Real.log (N K L : ℝ) ^ 2 / (L : ℝ) rw [← Real.sqrt_eq_rpow, div_pow, Real.sq_sqrt hL.le] ring apply squeeze_zero' (Eventually.of_forall (fun L => by positivity)) _ ht' filter_upwards [eventually_L_pos, eventually_B_le_logN hK, (tendsto_N hK).eventually (eventually_ge_atTop 1)] with L hL hb hn have hl := Real.log_nonneg hn have he : (ell K L : ℝ) ≤ Real.log (N K L : ℝ) / (2 * Real.log 2) := Nat.floor_le (by positivity) calc _ ≤ Real.log (N K L : ℝ) * (Real.log (N K L : ℝ) / (2 * Real.log 2)) * Real.sqrt (N K L : ℝ) / (L : ℝ) ^ 2 := by gcongr exact pow_ell_le_sqrt hn _ = _ := by rw [sqrtN_eq]; field_simp <;> ring /-- Natural division is bounded before taking limits; it is not silently replaced by real division. -/ lemma unaryCost_le_real {K L : ℕ} (he : 0 < ell K L) : (unaryCost K L : ℝ) ≤ 2 * (B K L : ℝ) * ((ell K L : ℝ) * (2 : ℝ) ^ ell K L + K * ((L : ℝ) ^ 2 / ell K L + 1)) := by have hd : ((L ^ 2 / ell K L : ℕ) : ℝ) ≤ (L : ℝ) ^ 2 / ell K L := by apply (le_div_iff₀ (show (0 : ℝ) < ell K L by exact_mod_cast he)).mpr exact_mod_cast Nat.div_mul_le_self (L ^ 2) (ell K L) dsimp [unaryCost] push_cast gcongr lemma tendsto_unaryCost {K : ℕ} (hK : 0 < K) : Tendsto (fun L : ℕ => (unaryCost K L : ℝ) / (L : ℝ) ^ 2) atTop (𝓝 0) := by have hb2 : Tendsto (fun L : ℕ => (B K L : ℝ) / (L : ℝ) ^ 2) atTop (𝓝 0) := by simpa only [Real.rpow_two] using tendsto_B_div_rpow hK (by norm_num : (0 : ℝ) < 2) have ht := (tendsto_dictionaryCost hK).const_mul 2 |>.add (((tendsto_B_div_ell hK).add hb2).const_mul (2 * (K : ℝ))) simp only [mul_zero, add_zero] at ht apply squeeze_zero' (Eventually.of_forall (fun L => by positivity)) _ ht filter_upwards [eventually_pos hK, eventually_L_pos] with L hp hL calc _ ≤ (2 * (B K L : ℝ) * ((ell K L : ℝ) * (2 : ℝ) ^ ell K L + K * ((L : ℝ) ^ 2 / ell K L + 1))) / (L : ℝ) ^ 2 := div_le_div_of_nonneg_right (unaryCost_le_real hp.2.2) (sq_nonneg _) _ = _ := by field_simp <;> ring lemma tendsto_rowMoment {K : ℕ} (hK : 0 < K) : Tendsto (fun L : ℕ => (K : ℝ) * (B K L + 4 * E L + 2) * (1 + Real.log L) / L) atTop (𝓝 0) := by have hb : Tendsto (fun L : ℕ => (B K L : ℝ) / Real.sqrt L) atTop (𝓝 0) := by simpa only [Real.sqrt_eq_rpow] using tendsto_B_div_rpow hK (by norm_num : (0 : ℝ) < 1 / 2) have hl : Tendsto (fun L : ℕ => Real.log L / Real.sqrt L) atTop (𝓝 0) := by simpa only [Function.comp_def, Real.sqrt_eq_rpow] using (isLittleO_log_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 2)).tendsto_div_nhds_zero.comp tendsto_L have ht := ((hb.add (tendsto_E_div_sqrt.const_mul 4)).add (tendsto_sqrtL.inv_tendsto_atTop.const_mul 2)).mul (tendsto_sqrtL.inv_tendsto_atTop.add hl) |>.const_mul (K : ℝ) simp only [mul_zero, add_zero] at ht apply ht.congr' filter_upwards [eventually_L_pos] with L hL have hs := Real.sq_sqrt hL.le have hs0 := (Real.sqrt_pos.mpr hL).ne' change (K : ℝ) * (((B K L : ℝ) / Real.sqrt (L : ℝ) + 4 * (E L / Real.sqrt (L : ℝ)) + 2 * (Real.sqrt (L : ℝ))⁻¹) * ((Real.sqrt (L : ℝ))⁻¹ + Real.log (L : ℝ) / Real.sqrt (L : ℝ))) = (K : ℝ) * ((B K L : ℝ) + 4 * E L + 2) * (1 + Real.log (L : ℝ)) / (L : ℝ) calc _ = (K : ℝ) * ((B K L : ℝ) + 4 * E L + 2) * (1 + Real.log (L : ℝ)) / Real.sqrt (L : ℝ) ^ 2 := by field_simp [hs0] <;> ring _ = _ := by rw [hs] /-- The reachable-bin estimate alone makes the variance loss negligible. -/ lemma variance_loss {K : ℕ} (hK : 0 < K) {G C : ℝ} (hG : 0 ≤ G) (hC : 0 ≤ C) (Q : ℕ → ℝ) (J : ℕ → ℕ) (hQ : ∀ L, 0 ≤ Q L) (hQt : Tendsto (fun L : ℕ => Q L / (L : ℝ) ^ 2) atTop (𝓝 0)) (hJ : ∀ᶠ L : ℕ in atTop, (J L : ℝ) ≤ C * (L : ℝ) ^ 2 / B K L + 2) : Tendsto (fun L : ℕ => Real.sqrt ((J L : ℝ) * (G * (L : ℝ) ^ 2 + 2 * Q L)) / (L : ℝ) ^ 2) atTop (𝓝 0) := by have hBinv : Tendsto (fun L : ℕ => (B K L : ℝ)⁻¹) atTop (𝓝 0) := (tendsto_natCast_atTop_atTop.comp (tendsto_B hK)).inv_tendsto_atTop have hLinv : Tendsto (fun L : ℕ => ((L : ℝ) ^ 2)⁻¹) atTop (𝓝 0) := ((tendsto_pow_atTop (by decide : 2 ≠ 0)).comp tendsto_L).inv_tendsto_atTop have hJt : Tendsto (fun L : ℕ => (J L : ℝ) / (L : ℝ) ^ 2) atTop (𝓝 0) := by have ht := (hBinv.const_mul C).add (hLinv.const_mul 2) simp only [mul_zero, add_zero] at ht apply squeeze_zero' (Eventually.of_forall (fun L => by positivity)) _ ht filter_upwards [hJ, eventually_L_pos] with L hj hL calc _ ≤ (C * (L : ℝ) ^ 2 / B K L + 2) / (L : ℝ) ^ 2 := div_le_div_of_nonneg_right hj (sq_nonneg _) _ = _ := by field_simp <;> ring have ht := hJt.mul ((tendsto_const_nhds (x := G)).add (hQt.const_mul 2)) simp only [mul_zero, add_zero, zero_mul] at ht have hs := Real.continuous_sqrt.continuousAt.tendsto.comp ht simp only [Real.sqrt_zero] at hs apply hs.congr' filter_upwards [eventually_L_pos] with L hL change Real.sqrt ((J L : ℝ) / (L : ℝ) ^ 2 * (G + 2 * (Q L / (L : ℝ) ^ 2))) = Real.sqrt ((J L : ℝ) * (G * (L : ℝ) ^ 2 + 2 * Q L)) / (L : ℝ) ^ 2 have hq := hQ L have hid : (J L : ℝ) / (L : ℝ) ^ 2 * (G + 2 * (Q L / (L : ℝ) ^ 2)) = ((J L : ℝ) * (G * (L : ℝ) ^ 2 + 2 * Q L)) / ((L : ℝ) ^ 2) ^ 2 := by field_simp <;> ring rw [hid, Real.sqrt_div (by positivity), Real.sqrt_sq (sq_nonneg (L : ℝ))] end DistanceCounts.ConstructionScales end end BodyFile074 -- Source: DistanceCounts/RotationEstimate.lean section BodyFile075 /-! Exact Fourier and finite-sum prerequisites for averaged rotation discrepancy. The quantitative integral estimates are NOT asserted here. The two remaining analytic estimates are the L1 Fourier remainder bound and the logarithmic integral bound for `geometricMajorant`; see the final comment. In particular this file does not certify an L^(3/4) exceptional-set estimate. -/ noncomputable section open scoped BigOperators Real open MeasureTheory Set namespace DistanceCounts.RotationEstimate /-- The sawtooth, with its actual value -1/2 at integers. -/ def saw (x : ℝ) : ℝ := Int.fract x - 1 / 2 def sawCircle (x : UnitAddCircle) : ℂ := periodizedBernoulli 1 x theorem sawCircle_coe (x : ℝ) : sawCircle (x : UnitAddCircle) = (saw x : ℂ) := by rw [← AddCircle.coe_fract x] unfold sawCircle periodizedBernoulli rw [AddCircle.liftIco_coe_apply (show Int.fract x ∈ Ico (0 : ℝ) (0 + 1) from ⟨Int.fract_nonneg x, by simpa using Int.fract_lt_one x⟩)] simp [bernoulliFun_one, saw] /-- Includes the zero coefficient: division by zero on the right is zero. -/ theorem sawCircle_fourierCoeff (h : ℤ) : fourierCoeff sawCircle h = -1 / (2 * Real.pi * Complex.I * h) := by have hfun : sawCircle = ((↑) ∘ periodizedBernoulli 1 : UnitAddCircle → ℂ) := by funext x rfl rw [hfun] simpa only [Nat.factorial_one, Nat.cast_one, pow_one] using (fourierCoeff_bernoulli_eq (k := 1) one_ne_zero h) /-- Nonzero integer dilations preserve normalized Haar measure; this is the measure-preservation needed for every positive-index truncation remainder. -/ theorem integral_integer_rotation (f : UnitAddCircle → ℝ) (hf : AEStronglyMeasurable f AddCircle.haarAddCircle) {n : ℤ} (hn : n ≠ 0) : (∫ x : UnitAddCircle, f (n • x) ∂AddCircle.haarAddCircle) = ∫ x : UnitAddCircle, f x ∂AddCircle.haarAddCircle := by have hp : MeasurePreserving (fun x : UnitAddCircle => n • x) AddCircle.haarAddCircle AddCircle.haarAddCircle := Measure.measurePreserving_zsmul AddCircle.haarAddCircle hn have hm : AEStronglyMeasurable f (Measure.map (fun x : UnitAddCircle => n • x) AddCircle.haarAddCircle) := by rw [hp.map_eq] exact hf have hi := integral_map hp.measurable.aemeasurable hm rw [hp.map_eq] at hi exact hi.symm /-- The total integrated error at the L positive rotation samples is exactly L times the integrated one-sample error. -/ theorem integral_sum_positive_rotations (f : UnitAddCircle → ℝ) (hf : Integrable f AddCircle.haarAddCircle) (L : ℕ) : (∫ x : UnitAddCircle, (∑ n ∈ Finset.range L, f (((n + 1 : ℕ) : ℤ) • x)) ∂AddCircle.haarAddCircle) = (L : ℝ) * ∫ x : UnitAddCircle, f x ∂AddCircle.haarAddCircle := by rw [integral_finsetSum] · have hi (n : ℕ) : (∫ x : UnitAddCircle, f (((n + 1 : ℕ) : ℤ) • x) ∂AddCircle.haarAddCircle) = ∫ x : UnitAddCircle, f x ∂AddCircle.haarAddCircle := integral_integer_rotation f hf.aestronglyMeasurable (by omega) simp_rw [hi] simp · intro n hn have hp : MeasurePreserving (fun x : UnitAddCircle => ((n + 1 : ℕ) : ℤ) • x) AddCircle.haarAddCircle AddCircle.haarAddCircle := Measure.measurePreserving_zsmul AddCircle.haarAddCircle (by omega) exact hp.integrable_comp_of_integrable hf def coefficient (h : ℤ) : ℂ := -1 / (2 * Real.pi * Complex.I * h) theorem norm_coefficient (h : ℤ) : ‖coefficient h‖ = 1 / (2 * Real.pi * |(h : ℝ)|) := by simp [coefficient, norm_div, norm_mul, Real.pi_pos.le, abs_of_nonneg] /-- A Fourier character on a real representative. -/ def phase (h : ℤ) (θ : ℝ) : ℂ := Complex.exp (2 * Real.pi * Complex.I * h * θ) theorem phase_eq_fourier (h : ℤ) (θ : ℝ) : phase h θ = fourier h (θ : UnitAddCircle) := by simp [phase, fourier_coe_apply] theorem norm_phase (h : ℤ) (θ : ℝ) : ‖phase h θ‖ = 1 := by rw [phase_eq_fourier, fourier_apply] exact Circle.norm_coe _ theorem phase_nat_mul (h : ℤ) (θ : ℝ) (n : ℕ) : phase h ((n : ℝ) * θ) = phase h θ ^ n := by unfold phase rw [← Complex.exp_nat_mul] congr 1 push_cast ring /-- A finite Fourier polynomial; taking `S = Icc (-H) H` gives the usual truncation. -/ def polynomial (S : Finset ℤ) (θ : ℝ) : ℂ := ∑ h ∈ S, coefficient h * phase h θ /-- The cap is essential: at resonant angles the geometric sum has size N, not zero. Thus no exceptional angle is silently discarded. -/ def geometricMajorant (L : ℕ) (z : ℂ) : ℝ := if z = 1 then L else min (L : ℝ) (2 / ‖z - 1‖) theorem geometricMajorant_nonneg (L : ℕ) (z : ℂ) : 0 ≤ geometricMajorant L z := by unfold geometricMajorant split_ifs · positivity · exact le_min (Nat.cast_nonneg _) (by positivity) theorem norm_geometric_sum_le_length (z : ℂ) (hz : ‖z‖ = 1) (N : ℕ) : ‖∑ n ∈ Finset.range N, z ^ n‖ ≤ N := by calc ‖∑ n ∈ Finset.range N, z ^ n‖ ≤ ∑ n ∈ Finset.range N, ‖z ^ n‖ := norm_sum_le _ _ _ = N := by simp [norm_pow, hz] theorem norm_geometric_sum_le_div (z : ℂ) (hz : ‖z‖ = 1) (hz1 : z ≠ 1) (N : ℕ) : ‖∑ n ∈ Finset.range N, z ^ n‖ ≤ 2 / ‖z - 1‖ := by have hd : 0 < ‖z - 1‖ := norm_pos_iff.mpr (sub_ne_zero.mpr hz1) apply (le_div_iff₀ hd).mpr rw [← norm_mul, geom_sum_mul] calc ‖z ^ N - 1‖ ≤ ‖z ^ N‖ + ‖(1 : ℂ)‖ := norm_sub_le _ _ _ = 2 := by norm_num [norm_pow, hz] /-- Simultaneous pointwise bound for every positive prefix of length at most L. -/ theorem norm_positive_geometric_sum_le (z : ℂ) (hz : ‖z‖ = 1) {N L : ℕ} (hNL : N ≤ L) : ‖∑ n ∈ Finset.range N, z ^ (n + 1)‖ ≤ geometricMajorant L z := by have hshift : ‖∑ n ∈ Finset.range N, z ^ (n + 1)‖ = ‖∑ n ∈ Finset.range N, z ^ n‖ := by simp only [pow_succ, ← Finset.sum_mul, norm_mul, hz, mul_one] rw [hshift] have hlength : ‖∑ n ∈ Finset.range N, z ^ n‖ ≤ (L : ℝ) := (norm_geometric_sum_le_length z hz N).trans (by exact_mod_cast hNL) unfold geometricMajorant split_ifs with hz1 · exact hlength · exact le_min hlength (norm_geometric_sum_le_div z hz hz1 N) /-- Every prefix of a finite Fourier polynomial is controlled by one nonnegative function of θ, independently of the prefix endpoint. -/ theorem polynomial_prefix_bound (S : Finset ℤ) (θ : ℝ) {N L : ℕ} (hNL : N ≤ L) : ‖∑ n ∈ Finset.range N, polynomial S (((n + 1 : ℕ) : ℝ) * θ)‖ ≤ ∑ h ∈ S, ‖coefficient h‖ * geometricMajorant L (phase h θ) := by classical simp only [polynomial, phase_nat_mul] rw [Finset.sum_comm] simp only [← Finset.mul_sum] calc ‖∑ h ∈ S, coefficient h * ∑ n ∈ Finset.range N, phase h θ ^ (n + 1)‖ ≤ ∑ h ∈ S, ‖coefficient h * ∑ n ∈ Finset.range N, phase h θ ^ (n + 1)‖ := norm_sum_le _ _ _ ≤ ∑ h ∈ S, ‖coefficient h‖ * geometricMajorant L (phase h θ) := by apply Finset.sum_le_sum intro h hh rw [norm_mul] exact mul_le_mul_of_nonneg_left (norm_positive_geometric_sum_le _ (norm_phase h θ) hNL) (norm_nonneg _) /-- The full residual cost through L; importantly, its samples start at 1, since the n=0 map does not preserve uniform measure. -/ def remainderCost (S : Finset ℤ) (L : ℕ) (θ : ℝ) : ℝ := ∑ n ∈ Finset.range L, ‖(saw (((n + 1 : ℕ) : ℝ) * θ) : ℂ) - polynomial S (((n + 1 : ℕ) : ℝ) * θ)‖ def prefixMajorant (S : Finset ℤ) (L : ℕ) (θ : ℝ) : ℝ := remainderCost S L θ + ∑ h ∈ S, ‖coefficient h‖ * geometricMajorant L (phase h θ) theorem prefixMajorant_nonneg (S : Finset ℤ) (L : ℕ) (θ : ℝ) : 0 ≤ prefixMajorant S L θ := by apply add_nonneg · exact Finset.sum_nonneg fun _ _ => norm_nonneg _ · exact Finset.sum_nonneg fun h _ => mul_nonneg (norm_nonneg _) (geometricMajorant_nonneg _ _) /-- Exact deterministic reduction of the maximal-prefix problem to two nonnegative, explicitly defined Fourier costs. No approximation hypothesis. -/ theorem saw_prefix_bound (S : Finset ℤ) (θ : ℝ) {N L : ℕ} (hNL : N ≤ L) : |∑ n ∈ Finset.range N, saw (((n + 1 : ℕ) : ℝ) * θ)| ≤ prefixMajorant S L θ := by classical let a : ℕ → ℂ := fun n => saw (((n + 1 : ℕ) : ℝ) * θ) let p : ℕ → ℂ := fun n => polynomial S (((n + 1 : ℕ) : ℝ) * θ) have heq : (∑ n ∈ Finset.range N, a n) = (∑ n ∈ Finset.range N, (a n - p n)) + ∑ n ∈ Finset.range N, p n := by simp only [Finset.sum_sub_distrib, sub_add_cancel] have hrem : ‖∑ n ∈ Finset.range N, (a n - p n)‖ ≤ remainderCost S L θ := by apply (norm_sum_le _ _).trans exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.range_mono hNL) (fun _ _ _ => norm_nonneg _) have hnorm : |∑ n ∈ Finset.range N, saw (((n + 1 : ℕ) : ℝ) * θ)| = ‖∑ n ∈ Finset.range N, a n‖ := by simp [a, ← Complex.ofReal_sum] rw [hnorm, heq] exact (norm_add_le _ _).trans (add_le_add hrem (polynomial_prefix_bound S θ hNL)) /-- Every translated positive-index window is the difference of two prefixes. -/ theorem saw_window_eq_prefix_sub (a N : ℕ) (θ : ℝ) : (∑ n ∈ Finset.range N, saw (((a + n + 1 : ℕ) : ℝ) * θ)) = (∑ n ∈ Finset.range (a + N), saw (((n + 1 : ℕ) : ℝ) * θ)) - ∑ n ∈ Finset.range a, saw (((n + 1 : ℕ) : ℝ) * θ) := by rw [Finset.sum_range_add] simp [add_comm, add_left_comm, add_assoc] /-- Window bound with no new analytic input. -/ theorem saw_window_bound (S : Finset ℤ) (θ : ℝ) {a N L : ℕ} (h : a + N ≤ L) : |∑ n ∈ Finset.range N, saw (((a + n + 1 : ℕ) : ℝ) * θ)| ≤ 2 * prefixMajorant S L θ := by rw [saw_window_eq_prefix_sub] calc _ ≤ |∑ n ∈ Finset.range (a + N), saw (((n + 1 : ℕ) : ℝ) * θ)| + |∑ n ∈ Finset.range a, saw (((n + 1 : ℕ) : ℝ) * θ)| := abs_sub _ _ _ ≤ prefixMajorant S L θ + prefixMajorant S L θ := add_le_add (saw_prefix_bound S θ h) (saw_prefix_bound S θ (by omega)) _ = 2 * prefixMajorant S L θ := by ring /-- A skew-gadget window splits into two positive prefixes, one at θ and one at -θ, and the genuine value at zero. No irrationality assumption or almost-everywhere convention is needed for this identity. -/ theorem skew_saw_eq_positive_prefixes (θ : ℝ) {y L : ℕ} (hy : y < L) : (∑ r ∈ Finset.range L, saw (θ * ((y : ℝ) - r))) = (∑ n ∈ Finset.range y, saw (((n + 1 : ℕ) : ℝ) * θ)) + (∑ n ∈ Finset.range (L - (y + 1)), saw (((n + 1 : ℕ) : ℝ) * (-θ))) - 1 / 2 := by have hfront : (∑ r ∈ Finset.range (y + 1), saw (θ * ((y : ℝ) - r))) = (∑ n ∈ Finset.range y, saw (((n + 1 : ℕ) : ℝ) * θ)) - 1 / 2 := by calc _ = ∑ r ∈ Finset.range (y + 1), saw (((y + 1 - 1 - r : ℕ) : ℝ) * θ) := by apply Finset.sum_congr rfl intro r hr have hry : r ≤ y := by have := Finset.mem_range.mp hr omega simp only [Nat.add_sub_cancel, Nat.cast_sub hry] congr 1 ring _ = ∑ r ∈ Finset.range (y + 1), saw ((r : ℝ) * θ) := Finset.sum_range_reflect (fun r : ℕ => saw ((r : ℝ) * θ)) (y + 1) _ = _ := by rw [Finset.sum_range_succ'] simp [saw, sub_eq_add_neg] have hback : (∑ r ∈ Finset.range (L - (y + 1)), saw (θ * ((y : ℝ) - ((y + 1 + r : ℕ) : ℝ)))) = ∑ r ∈ Finset.range (L - (y + 1)), saw (((r + 1 : ℕ) : ℝ) * (-θ)) := by apply Finset.sum_congr rfl intro r hr congr 1 push_cast ring have hL : L = (y + 1) + (L - (y + 1)) := by omega conv_lhs => rw [hL, Finset.sum_range_add] rw [hfront, hback] ring /-- The exact fractional-part error used by the gadget is bounded uniformly in its row index by the two explicit positive-prefix majorants. -/ theorem skew_centered_error_bound (S : Finset ℤ) (θ : ℝ) {y L : ℕ} (hy : y < L) : |∑ r ∈ Finset.range L, (1 / 2 - Int.fract (θ * ((y : ℝ) - r)))| ≤ 1 / 2 + prefixMajorant S L θ + prefixMajorant S L (-θ) := by have heq : (∑ r ∈ Finset.range L, (1 / 2 - Int.fract (θ * ((y : ℝ) - r)))) = -(∑ r ∈ Finset.range L, saw (θ * ((y : ℝ) - r))) := by rw [← Finset.sum_neg_distrib] apply Finset.sum_congr rfl intro r hr simp [saw] rw [heq, abs_neg, skew_saw_eq_positive_prefixes θ hy] calc _ ≤ |(∑ n ∈ Finset.range y, saw (((n + 1 : ℕ) : ℝ) * θ)) + ∑ n ∈ Finset.range (L - (y + 1)), saw (((n + 1 : ℕ) : ℝ) * (-θ))| + |(1 / 2 : ℝ)| := abs_sub _ _ _ ≤ (|∑ n ∈ Finset.range y, saw (((n + 1 : ℕ) : ℝ) * θ)| + |∑ n ∈ Finset.range (L - (y + 1)), saw (((n + 1 : ℕ) : ℝ) * (-θ))|) + 1 / 2 := by simpa only [Real.norm_eq_abs, abs_of_pos (by norm_num : (0 : ℝ) < 1 / 2)] using add_le_add (norm_add_le (∑ n ∈ Finset.range y, saw (((n + 1 : ℕ) : ℝ) * θ)) (∑ n ∈ Finset.range (L - (y + 1)), saw (((n + 1 : ℕ) : ℝ) * (-θ)))) (le_refl (1 / 2 : ℝ)) _ ≤ (prefixMajorant S L θ + prefixMajorant S L (-θ)) + 1 / 2 := add_le_add (add_le_add (saw_prefix_bound S θ (N := y) (L := L) hy.le) (saw_prefix_bound S (-θ) (N := L - (y + 1)) (L := L) (Nat.sub_le L (y + 1)))) (le_refl (1 / 2 : ℝ)) _ = _ := by ring /-- Localization of any nonnegative majorant to a fixed parameter interval. The factor 1/δ is precisely normalization by the interval's length. -/ theorem normalized_subinterval_bound {f : ℝ → ℝ} {δ B : ℝ} (hδ : 0 < δ) (hδ1 : δ ≤ 1) (hf : IntegrableOn f (Icc (0 : ℝ) 1)) (hnonneg : ∀ x, 0 ≤ f x) (hB : ∫ x in Icc (0 : ℝ) 1, f x ≤ B) : (∫ x in Icc (0 : ℝ) δ, f x) / δ ≤ B / δ := by apply div_le_div_of_nonneg_right _ hδ.le apply le_trans _ hB exact setIntegral_mono_set hf (Filter.Eventually.of_forall hnonneg) (Filter.Eventually.of_forall fun x hx => ⟨hx.1, hx.2.trans hδ1⟩) /- Remaining analytic estimates, not declarations or assumptions: `fourier_remainder_L1`: for S = Icc (-H) H, H >= 1, integral_[0,1] norm(saw - polynomial S) <= C / sqrt H, with preservation of this integral by each nonzero integer rotation sample. `geometricMajorant_integral`: for L >= 1 and nonzero h, integral_[0,1] geometricMajorant L (phase h theta) <= C * (1 + log L). Together with the elementary harmonic sum bound these give integral prefixMajorant (Icc (-L) L) L <= C * (sqrt L + (1 + log L)^2). The source above proves the exact coefficient formula and the pointwise maximal-prefix reduction, including all resonant angles, but does not prove either displayed integral estimate or claim the resulting probabilistic rate. -/ end DistanceCounts.RotationEstimate end end BodyFile075 -- Source: DistanceCounts/RotationFourierTail.lean section BodyFile076 noncomputable section open scoped BigOperators Real ENNReal open MeasureTheory Set namespace DistanceCounts.RotationFourierTail open RotationEstimate /-- The polynomial on the circle, with exactly the coefficients and zero-mode convention of `RotationEstimate.polynomial`. -/ def circlePolynomial (S : Finset ℤ) (x : UnitAddCircle) : ℂ := ∑ h ∈ S, coefficient h * fourier h x theorem circlePolynomial_coe (S : Finset ℤ) (x : ℝ) : circlePolynomial S (x : UnitAddCircle) = polynomial S x := by simp only [circlePolynomial, polynomial, phase_eq_fourier] theorem measurable_sawCircle : Measurable sawCircle := by change Measurable (fun x : UnitAddCircle => (bernoulliFun 1 ((AddCircle.measurableEquivIco 1 0 x : Ico (0 : ℝ) (0 + 1)) : ℝ) : ℂ)) simp only [bernoulliFun_one] exact Complex.continuous_ofReal.measurable.comp ((measurable_subtype_coe.comp (AddCircle.measurableEquivIco 1 0).measurable).sub measurable_const) theorem norm_sawCircle_le (x : UnitAddCircle) : ‖sawCircle x‖ ≤ 1 := by change ‖(bernoulliFun 1 ((AddCircle.equivIco 1 0 x : Ico (0 : ℝ) (0 + 1)) : ℝ) : ℂ)‖ ≤ 1 rw [bernoulliFun_one, Complex.norm_real, Real.norm_eq_abs] have hx := (AddCircle.equivIco 1 0 x).property apply abs_le.mpr constructor <;> linarith [hx.1, hx.2] /-- In particular, the actual endpoint-valued sawtooth is in L²; no replacement by a continuous function or unproved Fourier representative is used. -/ theorem memLp_sawCircle (p : ℝ≥0∞) : MemLp sawCircle p AddCircle.haarAddCircle := MemLp.of_bound measurable_sawCircle.aestronglyMeasurable 1 (ae_of_all _ norm_sawCircle_le) private theorem memLp_term (p : ℝ≥0∞) (h : ℤ) : MemLp (fun x : UnitAddCircle => coefficient h * fourier h x) p AddCircle.haarAddCircle := by apply MemLp.of_bound (continuous_const.mul (fourier h).continuous).aestronglyMeasurable ‖coefficient h‖ apply ae_of_all intro x simp only [Pi.mul_apply, norm_mul, fourier_apply, Circle.norm_coe, mul_one, le_refl] theorem memLp_circlePolynomial (p : ℝ≥0∞) (S : Finset ℤ) : MemLp (circlePolynomial S) p AddCircle.haarAddCircle := memLp_finsetSum S (fun h _ => memLp_term p h) theorem integrable_circle_remainder (S : Finset ℤ) : Integrable (fun x : UnitAddCircle => ‖sawCircle x - circlePolynomial S x‖) AddCircle.haarAddCircle := ((memLp_sawCircle 2).sub (memLp_circlePolynomial 2 S)).norm.integrable (by norm_num) private theorem circlePolynomial_fourierCoeff (S : Finset ℤ) (k : ℤ) : fourierCoeff (circlePolynomial S) k = if k ∈ S then coefficient k else 0 := by classical have hfun : circlePolynomial S = ∑ h ∈ S, (fun x : UnitAddCircle => coefficient h * fourier h x) := by ext x simp only [circlePolynomial, Finset.sum_apply] rw [hfun, fourierCoeff.sum S _ (fun h _ => (memLp_term 1 h).integrable le_rfl)] simp only [Finset.sum_apply, fourierCoeff.const_mul, fourierCoeff_fourier, Pi.single_apply, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq, Finset.sum_ite_eq'] private theorem remainder_fourierCoeff (S : Finset ℤ) (k : ℤ) : fourierCoeff (fun x : UnitAddCircle => sawCircle x - circlePolynomial S x) k = if k ∈ S then 0 else coefficient k := by classical have hs := (memLp_sawCircle 1).integrable le_rfl have hp := (memLp_circlePolynomial 1 S).integrable le_rfl change (∫ x : UnitAddCircle, fourier (-k) x • (sawCircle x - circlePolynomial S x) ∂AddCircle.haarAddCircle) = _ simp_rw [smul_sub] rw [integral_sub (hs.fourier_smul _) (hp.fourier_smul _)] change fourierCoeff sawCircle k - fourierCoeff (circlePolynomial S) k = _ rw [sawCircle_fourierCoeff, circlePolynomial_fourierCoeff] by_cases hk : k ∈ S <;> simp [hk, coefficient] /-- Parseval applied to the actual L² difference, rather than an assumed pointwise Fourier expansion. -/ theorem hasSum_remainder_sq (S : Finset ℤ) : HasSum (fun k : ℤ => if k ∈ S then 0 else ‖coefficient k‖ ^ 2) (∫ x : UnitAddCircle, ‖sawCircle x - circlePolynomial S x‖ ^ 2 ∂AddCircle.haarAddCircle) := by classical let hr := (memLp_sawCircle 2).sub (memLp_circlePolynomial 2 S) let g : Lp ℂ 2 AddCircle.haarAddCircle := hr.toLp (sawCircle - circlePolynomial S) have hp := hasSum_sq_fourierCoeff g have hc := fourierCoeff_congr_ae hr.coeFn_toLp have hi : (∫ x : UnitAddCircle, ‖g x‖ ^ 2 ∂AddCircle.haarAddCircle) = ∫ x : UnitAddCircle, ‖sawCircle x - circlePolynomial S x‖ ^ 2 ∂AddCircle.haarAddCircle := by apply integral_congr_ae filter_upwards [hr.coeFn_toLp] with x hx rw [hx] rfl rw [hi] at hp convert hp using 1 ext k rw [congrFun hc k] change (if k ∈ S then 0 else ‖coefficient k‖ ^ 2) = ‖fourierCoeff (fun x => sawCircle x - circlePolynomial S x) k‖ ^ 2 rw [remainder_fourierCoeff] by_cases hk : k ∈ S <;> simp [hk] private theorem coefficient_nat_sq_le (n : ℕ) : ‖coefficient (n : ℤ)‖ ^ 2 ≤ ((n : ℝ) ^ 2)⁻¹ := by by_cases hn : n = 0 · simp [hn, coefficient] have hn' : 0 < (n : ℝ) := by exact_mod_cast Nat.pos_of_ne_zero hn have hc : ‖coefficient (n : ℤ)‖ ≤ (n : ℝ)⁻¹ := by rw [norm_coefficient] simp only [Int.cast_natCast, abs_of_nonneg hn'.le] rw [← one_div] apply div_le_div_of_nonneg_left (by norm_num) hn' nlinarith [Real.pi_gt_three] calc ‖coefficient (n : ℤ)‖ ^ 2 ≤ ((n : ℝ)⁻¹) ^ 2 := pow_le_pow_left₀ (norm_nonneg _) hc 2 _ = ((n : ℝ) ^ 2)⁻¹ := by rw [inv_pow] /-- The two integer tails cost at most `2/H`. The bound is obtained from finite reciprocal-square sums, including a proof of their tail control. -/ theorem tsum_tail_sq_le {H : ℕ} (hH : 1 ≤ H) (hs : Summable (fun k : ℤ => if k ∈ Finset.Icc (-(H : ℤ)) H then 0 else ‖coefficient k‖ ^ 2)) : (∑' k : ℤ, if k ∈ Finset.Icc (-(H : ℤ)) H then 0 else ‖coefficient k‖ ^ 2) ≤ 2 / (H : ℝ) := by classical let f : ℤ → ℝ := fun k => if k ∈ Finset.Icc (-(H : ℤ)) H then 0 else ‖coefficient k‖ ^ 2 have hf0 : f 0 = 0 := by simp [f] have hfeven (k : ℤ) : f (-k) = f k := by have hm : -k ∈ Finset.Icc (-(H : ℤ)) H ↔ k ∈ Finset.Icc (-(H : ℤ)) H := by simp only [Finset.mem_Icc] omega simp only [f, hm, norm_coefficient, Int.cast_neg, abs_neg] have hsn : Summable (fun n : ℕ => f n) := hs.comp_injective Nat.cast_injective have hnat : (∑' n : ℕ, f n) ≤ (H : ℝ)⁻¹ := by apply Real.tsum_le_of_sum_le (fun n => by dsimp [f]; split_ifs <;> positivity) intro s let N := max H (s.sup id) have hsub : s.filter (fun n => H < n) ⊆ Finset.Ioc H N := by intro n hn obtain ⟨hns, hHn⟩ := Finset.mem_filter.mp hn exact Finset.mem_Ioc.mpr ⟨hHn, (Finset.le_sup (f := id) hns).trans (le_max_right _ _)⟩ calc (∑ n ∈ s, f n) ≤ ∑ n ∈ s, if H < n then ((n : ℝ) ^ 2)⁻¹ else 0 := by apply Finset.sum_le_sum intro n hn by_cases hnH : n ≤ H · have hnmem : (n : ℤ) ∈ Finset.Icc (-(H : ℤ)) H := by apply Finset.mem_Icc.mpr constructor <;> omega simp only [f, if_pos hnmem, if_neg (Nat.not_lt.mpr hnH), le_refl] · have hHn : H < n := Nat.lt_of_not_ge hnH have hnmem : (n : ℤ) ∉ Finset.Icc (-(H : ℤ)) H := by simp only [Finset.mem_Icc] omega simpa only [f, if_pos hHn, if_neg hnmem] using coefficient_nat_sq_le n _ = ∑ n ∈ s.filter (fun n => H < n), ((n : ℝ) ^ 2)⁻¹ := by rw [Finset.sum_filter] _ ≤ ∑ n ∈ Finset.Ioc H N, ((n : ℝ) ^ 2)⁻¹ := Finset.sum_le_sum_of_subset_of_nonneg hsub (fun _ _ _ => by positivity) _ ≤ (H : ℝ)⁻¹ - (N : ℝ)⁻¹ := sum_Ioc_inv_sq_le_sub (by omega) (le_max_left _ _) _ ≤ (H : ℝ)⁻¹ := sub_le_self _ (by positivity) have hsplit := tsum_nat_add_neg hs change (∑' n : ℕ, (f n + f (-(n : ℤ)))) = (∑' k : ℤ, f k) + f 0 at hsplit simp_rw [hfeven] at hsplit rw [hsn.tsum_add hsn, hf0, add_zero] at hsplit change (∑' k : ℤ, f k) ≤ _ rw [← hsplit] simpa [div_eq_mul_inv, two_mul] using add_le_add hnat hnat theorem integral_circle_remainder_sq_le {H : ℕ} (hH : 1 ≤ H) : (∫ x : UnitAddCircle, ‖sawCircle x - circlePolynomial (Finset.Icc (-(H : ℤ)) H) x‖ ^ 2 ∂AddCircle.haarAddCircle) ≤ 2 / (H : ℝ) := by have hp := hasSum_remainder_sq (Finset.Icc (-(H : ℤ)) H) rw [← hp.tsum_eq] exact tsum_tail_sq_le hH hp.summable /-- Cauchy--Schwarz from nonnegativity of the actual variance on normalized Haar measure. -/ private theorem sq_integral_le_integral_sq {f : UnitAddCircle → ℝ} (hf : MemLp f 2 AddCircle.haarAddCircle) : (∫ x, f x ∂AddCircle.haarAddCircle) ^ 2 ≤ ∫ x, f x ^ 2 ∂AddCircle.haarAddCircle := by have h := ProbabilityTheory.variance_nonneg f AddCircle.haarAddCircle rw [ProbabilityTheory.variance_eq_sub hf] at h exact sub_nonneg.mp h /-- An explicit universal constant: the L¹ remainder is at most `2 / sqrt H`. -/ theorem integral_circle_remainder_le {H : ℕ} (hH : 1 ≤ H) : (∫ x : UnitAddCircle, ‖sawCircle x - circlePolynomial (Finset.Icc (-(H : ℤ)) H) x‖ ∂AddCircle.haarAddCircle) ≤ 2 / Real.sqrt (H : ℝ) := by let m := ∫ x : UnitAddCircle, ‖sawCircle x - circlePolynomial (Finset.Icc (-(H : ℤ)) H) x‖ ∂AddCircle.haarAddCircle have hpos : 0 < (H : ℝ) := by exact_mod_cast (show 0 < H by omega) have hs : m ^ 2 ≤ 2 / (H : ℝ) := (sq_integral_le_integral_sq (((memLp_sawCircle 2).sub (memLp_circlePolynomial 2 (Finset.Icc (-(H : ℤ)) H))).norm)).trans (integral_circle_remainder_sq_le hH) have hm : (m * Real.sqrt (H : ℝ)) ^ 2 ≤ 2 := by rw [mul_pow, Real.sq_sqrt hpos.le] exact (le_div_iff₀ hpos).mp hs apply (le_div_iff₀ (Real.sqrt_pos.mpr hpos)).mpr change m * Real.sqrt (H : ℝ) ≤ 2 nlinarith [sq_nonneg (m * Real.sqrt (H : ℝ) - 2)] theorem integrableOn_remainder (S : Finset ℤ) : IntegrableOn (fun θ : ℝ => ‖(saw θ : ℂ) - polynomial S θ‖) (Icc 0 1) := by have hμ : (volume : Measure UnitAddCircle) = AddCircle.haarAddCircle := by simpa using (AddCircle.volume_eq_smul_haarAddCircle (T := (1 : ℝ))) have hi := integrable_circle_remainder S rw [← hμ] at hi have ht := (UnitAddCircle.measurePreserving_mk 0).integrable_comp_of_integrable hi apply (integrableOn_Icc_iff_integrableOn_Ioc (by finiteness)).mpr simpa only [IntegrableOn, Function.comp_def, zero_add, sawCircle_coe, circlePolynomial_coe] using ht theorem integral_remainder_eq_circle (S : Finset ℤ) : (∫ θ in Icc (0 : ℝ) 1, ‖(saw θ : ℂ) - polynomial S θ‖) = ∫ x : UnitAddCircle, ‖sawCircle x - circlePolynomial S x‖ ∂AddCircle.haarAddCircle := by rw [integral_Icc_eq_integral_Ioc, AddCircle.integral_haarAddCircle] simpa only [zero_add, inv_one, one_smul, sawCircle_coe, circlePolynomial_coe] using (UnitAddCircle.integral_preimage 0 (fun x => ‖sawCircle x - circlePolynomial S x‖)) theorem integral_remainder_le {H : ℕ} (hH : 1 ≤ H) : (∫ θ in Icc (0 : ℝ) 1, ‖(saw θ : ℂ) - polynomial (Finset.Icc (-(H : ℤ)) H) θ‖) ≤ 2 / Real.sqrt (H : ℝ) := by rw [integral_remainder_eq_circle] exact integral_circle_remainder_le hH theorem exists_remainder_bound : ∃ C : ℝ, 0 < C ∧ ∀ H : ℕ, 1 ≤ H → IntegrableOn (fun θ : ℝ => ‖(saw θ : ℂ) - polynomial (Finset.Icc (-(H : ℤ)) H) θ‖) (Icc 0 1) ∧ (∫ θ in Icc (0 : ℝ) 1, ‖(saw θ : ℂ) - polynomial (Finset.Icc (-(H : ℤ)) H) θ‖) ≤ C / Real.sqrt (H : ℝ) := by refine ⟨2, by norm_num, fun H hH => ?_⟩ exact ⟨integrableOn_remainder _, integral_remainder_le hH⟩ end DistanceCounts.RotationFourierTail end end BodyFile076 -- Source: DistanceCounts/RotationGeometricIntegral.lean section BodyFile077 noncomputable section open scoped BigOperators Real open MeasureTheory Set namespace DistanceCounts.RotationEstimate /-- The resonant value is included in the global cap. -/ theorem geometricMajorant_le_length (L : ℕ) (z : ℂ) : geometricMajorant L z ≤ L := by unfold geometricMajorant split_ifs · exact le_rfl · exact min_le_left _ _ theorem measurable_geometricMajorant (L : ℕ) : Measurable (geometricMajorant L) := by unfold geometricMajorant exact Measurable.ite (isClosed_eq continuous_id continuous_const).measurableSet measurable_const (measurable_const.min (measurable_const.div ((measurable_id.sub measurable_const).norm))) private theorem integrable_geometricMajorant_comp {α : Type*} [MeasurableSpace α] {μ : Measure α} [IsFiniteMeasure μ] (L : ℕ) {f : α → ℂ} (hf : Measurable f) : Integrable (fun x => geometricMajorant L (f x)) μ := by refine (integrable_const (L : ℝ)).mono' ((measurable_geometricMajorant L).comp hf).aestronglyMeasurable ?_ exact Filter.Eventually.of_forall fun x => by rw [Real.norm_eq_abs, abs_of_nonneg (geometricMajorant_nonneg _ _)] exact geometricMajorant_le_length _ _ /-- Exact chord length; no convention at the endpoints is changed. -/ theorem norm_phase_one_sub_one (θ : ℝ) : ‖phase 1 θ - 1‖ = 2 * |Real.sin (Real.pi * θ)| := by have he : phase 1 θ = Complex.exp (Complex.I * ((2 * Real.pi * θ : ℝ) : ℂ)) := by unfold phase congr 1 push_cast ring rw [he, Complex.norm_exp_I_mul_ofReal_sub_one] have ha : 2 * Real.pi * θ / 2 = Real.pi * θ := by ring rw [ha, Real.norm_eq_abs, abs_mul] norm_num /-- Jordan's inequality on the two half intervals gives the distance to resonance. -/ theorem four_mul_min_le_norm_phase_sub_one {θ : ℝ} (hθ : θ ∈ Icc (0 : ℝ) 1) : 4 * min θ (1 - θ) ≤ ‖phase 1 θ - 1‖ := by rw [norm_phase_one_sub_one] have hs : 2 * min θ (1 - θ) ≤ Real.sin (Real.pi * θ) := by by_cases hh : θ ≤ 1 / 2 · rw [min_eq_left (by linarith)] have h := Real.le_sin_mul (x := 2 * θ) (by linarith [hθ.1]) (by linarith) convert h using 1 <;> congr 1 <;> ring · rw [min_eq_right (by linarith)] have h := Real.le_sin_mul (x := 2 * (1 - θ)) (by linarith [hθ.2]) (by linarith) have he : Real.pi / 2 * (2 * (1 - θ)) = Real.pi - Real.pi * θ := by ring rw [he, Real.sin_pi_sub] at h exact h have := le_abs_self (Real.sin (Real.pi * θ)) linarith /-- A genuine capped reciprocal, continuous even at zero. -/ private def cappedReciprocal (L : ℕ) (x : ℝ) : ℝ := (max (L : ℝ)⁻¹ x)⁻¹ private theorem continuous_cappedReciprocal {L : ℕ} (hL : 1 ≤ L) : Continuous (cappedReciprocal L) := by have hpos : 0 < (L : ℝ)⁻¹ := inv_pos.mpr (by exact_mod_cast (by omega : 0 < L)) exact (continuous_const.max continuous_id).inv₀ (fun x => ne_of_gt (lt_of_lt_of_le hpos (le_max_left _ _))) private theorem cappedReciprocal_nonneg {L : ℕ} (hL : 1 ≤ L) (x : ℝ) : 0 ≤ cappedReciprocal L x := by unfold cappedReciprocal exact inv_nonneg.mpr ((by positivity : 0 ≤ (L : ℝ)⁻¹).trans (le_max_left _ _)) private theorem geometricMajorant_le_cappedReciprocal {L : ℕ} (hL : 1 ≤ L) {z : ℂ} {x : ℝ} (hx : 0 ≤ x) (hd : 4 * x ≤ ‖z - 1‖) : geometricMajorant L z ≤ cappedReciprocal L x := by have hpos : 0 < (L : ℝ) := by exact_mod_cast (by omega : 0 < L) by_cases hc : x ≤ (L : ℝ)⁻¹ · simpa [cappedReciprocal, max_eq_left hc] using geometricMajorant_le_length L z · have hxpos : 0 < x := lt_trans (inv_pos.mpr hpos) (lt_of_not_ge hc) have hdpos : 0 < ‖z - 1‖ := by linarith have hz : z ≠ 1 := by intro hz simp [hz] at hdpos rw [geometricMajorant, if_neg hz, cappedReciprocal, max_eq_right (le_of_not_ge hc)] apply (min_le_right _ _).trans rw [← one_div] exact (div_le_div_iff₀ hdpos hxpos).mpr (by nlinarith) /-- Splitting at the cap threshold gives the elementary logarithm exactly. -/ private theorem integral_cappedReciprocal {L : ℕ} (hL : 1 ≤ L) : (∫ x in (0 : ℝ)..1, cappedReciprocal L x) = 1 + Real.log L := by have hpos : 0 < (L : ℝ) := by exact_mod_cast (by omega : 0 < L) have hone : (1 : ℝ) ≤ L := by exact_mod_cast hL let a : ℝ := (L : ℝ)⁻¹ have ha : 0 < a := inv_pos.mpr hpos have ha1 : a ≤ 1 := by dsimp [a] exact inv_le_one_of_one_le₀ hone have hc := continuous_cappedReciprocal hL have hleft : (∫ x in (0 : ℝ)..a, cappedReciprocal L x) = 1 := by calc _ = ∫ _x in (0 : ℝ)..a, (L : ℝ) := by apply intervalIntegral.integral_congr intro x hx rw [uIcc_of_le ha.le] at hx simp [cappedReciprocal, max_eq_left hx.2, a] _ = 1 := by simp [a, hpos.ne'] have hi : IntervalIntegrable (fun x : ℝ => x⁻¹) volume a 1 := by apply ContinuousOn.intervalIntegrable_of_Icc ha1 exact continuousOn_id.inv₀ (fun x hx => ne_of_gt (ha.trans_le hx.1)) have hright : (∫ x in a..1, cappedReciprocal L x) = Real.log L := by calc _ = ∫ x in a..1, x⁻¹ := by apply intervalIntegral.integral_congr intro x hx rw [uIcc_of_le ha1] at hx simp [cappedReciprocal, max_eq_right hx.1, a] _ = Real.log 1 - Real.log a := intervalIntegral.integral_eq_sub_of_hasDerivAt (fun x hx => Real.hasDerivAt_log (ne_of_gt (ha.trans_le (show a ≤ x from ((show x ∈ Icc a 1 from by simpa [uIcc_of_le ha1] using hx)).1)))) hi _ = Real.log L := by simp [a, Real.log_inv] rw [← intervalIntegral.integral_add_adjacent_intervals (hc.intervalIntegrable 0 a) (hc.intervalIntegrable a 1), hleft, hright] /-- The unit-frequency cap has logarithmic average, with universal constant 2. -/ theorem integral_geometricMajorant_phase_one_le {L : ℕ} (hL : 1 ≤ L) : (∫ θ in (0 : ℝ)..1, geometricMajorant L (phase 1 θ)) ≤ 2 * (1 + Real.log L) := by have hm : Measurable (phase 1) := by have hc : Continuous (phase 1) := by unfold phase; fun_prop exact hc.measurable have hi : IntervalIntegrable (fun θ => geometricMajorant L (phase 1 θ)) volume 0 1 := (intervalIntegrable_iff_integrableOn_Icc_of_le (by norm_num)).mpr (integrable_geometricMajorant_comp L hm) have hc := continuous_cappedReciprocal hL have hr : Continuous (fun x : ℝ => cappedReciprocal L (1 - x)) := hc.comp (continuous_const.sub continuous_id) calc _ ≤ ∫ θ in (0 : ℝ)..1, (cappedReciprocal L θ + cappedReciprocal L (1 - θ)) := by apply intervalIntegral.integral_mono_on (by norm_num) hi ((hc.add hr).intervalIntegrable 0 1) intro θ hθ have hd := four_mul_min_le_norm_phase_sub_one hθ by_cases hh : θ ≤ 1 - θ · rw [min_eq_left hh] at hd exact (geometricMajorant_le_cappedReciprocal hL hθ.1 hd).trans (le_add_of_nonneg_right (cappedReciprocal_nonneg hL _)) · rw [min_eq_right (le_of_not_ge hh)] at hd exact (geometricMajorant_le_cappedReciprocal hL (by linarith [hθ.2]) hd).trans (le_add_of_nonneg_left (cappedReciprocal_nonneg hL _)) _ = 2 * (1 + Real.log L) := by rw [intervalIntegral.integral_add (hc.intervalIntegrable 0 1) (hr.intervalIntegrable 0 1), intervalIntegral.integral_comp_sub_left] norm_num only [sub_self, sub_zero] rw [integral_cappedReciprocal hL] ring private theorem unitCircle_volume_eq_haar : (volume : Measure UnitAddCircle) = AddCircle.haarAddCircle := by rw [AddCircle.volume_eq_smul_haarAddCircle] simp /-- Nonzero frequencies have exactly the same average, by the actual integer endomorphism of Haar measure, followed by the interval covering map. -/ theorem integral_geometricMajorant_phase_eq_one (L : ℕ) {h : ℤ} (hh : h ≠ 0) : (∫ θ in (0 : ℝ)..1, geometricMajorant L (phase h θ)) = ∫ θ in (0 : ℝ)..1, geometricMajorant L (phase 1 θ) := by let f : UnitAddCircle → ℝ := fun x => geometricMajorant L (fourier 1 x) have hf : Integrable f AddCircle.haarAddCircle := integrable_geometricMajorant_comp L (fourier 1).continuous.measurable have hchar (θ : ℝ) : geometricMajorant L (phase h θ) = f (h • (θ : UnitAddCircle)) := by simp [f, phase_eq_fourier, fourier_apply] simp_rw [hchar] have hone (θ : ℝ) : geometricMajorant L (phase 1 θ) = f (θ : UnitAddCircle) := by rw [phase_eq_fourier] simp_rw [hone] have hrotation := integral_integer_rotation f hf.aestronglyMeasurable hh rw [← unitCircle_volume_eq_haar] at hrotation simpa only [zero_add] using (UnitAddCircle.intervalIntegral_preimage 0 (fun x => f (h • x))).trans (hrotation.trans (UnitAddCircle.intervalIntegral_preimage 0 f).symm) /-- Integrability includes all resonances. The proof transports the bounded measurable function through Haar-preserving integer dilation and interval lifting. -/ theorem integrableOn_geometricMajorant_phase (L : ℕ) {h : ℤ} (hh : h ≠ 0) : IntegrableOn (fun θ => geometricMajorant L (phase h θ)) (Icc (0 : ℝ) 1) := by let f : UnitAddCircle → ℝ := fun x => geometricMajorant L (fourier 1 x) have hf : Integrable f AddCircle.haarAddCircle := integrable_geometricMajorant_comp L (fourier 1).continuous.measurable have hp : MeasurePreserving (fun x : UnitAddCircle => h • x) AddCircle.haarAddCircle AddCircle.haarAddCircle := Measure.measurePreserving_zsmul AddCircle.haarAddCircle hh have hi := hp.integrable_comp_of_integrable hf rw [← unitCircle_volume_eq_haar] at hi have hl := (UnitAddCircle.measurePreserving_mk 0).integrable_comp_of_integrable hi have hioc : IntegrableOn (fun θ => geometricMajorant L (phase h θ)) (Ioc (0 : ℝ) 1) := by simpa [IntegrableOn, f, Function.comp_def, phase_eq_fourier, fourier_apply] using hl exact (integrableOn_Icc_iff_integrableOn_Ioc (by finiteness)).mpr hioc /-- Averaged capped geometric estimate, uniform over every nonzero integer frequency. The cap at a resonant angle remains L. -/ theorem integral_geometricMajorant_phase_le {L : ℕ} (hL : 1 ≤ L) {h : ℤ} (hh : h ≠ 0) : (∫ θ in Icc (0 : ℝ) 1, geometricMajorant L (phase h θ)) ≤ 2 * (1 + Real.log L) := by rw [integral_Icc_eq_integral_Ioc, ← intervalIntegral.integral_of_le (by norm_num : (0 : ℝ) ≤ 1), integral_geometricMajorant_phase_eq_one L hh] exact integral_geometricMajorant_phase_one_le hL end DistanceCounts.RotationEstimate end end BodyFile077 -- Source: DistanceCounts/RotationAverage.lean section BodyFile078 noncomputable section open scoped BigOperators Real ENNReal Topology open MeasureTheory Set Filter namespace DistanceCounts.RotationAverage open RotationEstimate RotationFourierTail ProjectionDensity /-- The quadratic cutoff makes the entire positive-sample remainder cost bounded. -/ def cutoffS (L : ℕ) : Finset ℤ := Finset.Icc (-((L ^ 2 : ℕ) : ℤ)) ((L ^ 2 : ℕ) : ℤ) private theorem volume_circle : (volume : Measure UnitAddCircle) = AddCircle.haarAddCircle := by simpa using (AddCircle.volume_eq_smul_haarAddCircle (T := (1 : ℝ))) private theorem integrable_lift {f : UnitAddCircle → ℝ} (hf : Integrable f AddCircle.haarAddCircle) : IntegrableOn (fun θ : ℝ => f (θ : UnitAddCircle)) (Icc 0 1) := by rw [← volume_circle] at hf have h := (UnitAddCircle.measurePreserving_mk 0).integrable_comp_of_integrable hf apply (integrableOn_Icc_iff_integrableOn_Ioc (by finiteness)).mpr simpa only [IntegrableOn, Function.comp_def, zero_add] using h private theorem integral_lift (f : UnitAddCircle → ℝ) : (∫ θ in Icc (0 : ℝ) 1, f (θ : UnitAddCircle)) = ∫ x, f x ∂AddCircle.haarAddCircle := by rw [integral_Icc_eq_integral_Ioc, AddCircle.integral_haarAddCircle] simpa only [zero_add, inv_one, one_smul] using UnitAddCircle.integral_preimage 0 f private def circlePrefix (S : Finset ℤ) (L : ℕ) (x : UnitAddCircle) : ℝ := (∑ n ∈ Finset.range L, ‖sawCircle (((n + 1 : ℕ) : ℤ) • x) - circlePolynomial S (((n + 1 : ℕ) : ℤ) • x)‖) + ∑ h ∈ S, ‖coefficient h‖ * geometricMajorant L (fourier h x) private theorem circlePrefix_coe (S : Finset ℤ) (L : ℕ) (θ : ℝ) : circlePrefix S L (θ : UnitAddCircle) = prefixMajorant S L θ := by simp only [circlePrefix, prefixMajorant, remainderCost, ← AddCircle.coe_zsmul, zsmul_eq_mul, Int.cast_natCast, sawCircle_coe, circlePolynomial_coe, phase_eq_fourier] private theorem integrable_circle_geometric (L : ℕ) (h : ℤ) : Integrable (fun x : UnitAddCircle => geometricMajorant L (fourier h x)) AddCircle.haarAddCircle := by refine (integrable_const (L : ℝ)).mono' ((measurable_geometricMajorant L).comp (fourier h).continuous.measurable).aestronglyMeasurable ?_ exact ae_of_all _ fun x => by rw [Real.norm_eq_abs, abs_of_nonneg (geometricMajorant_nonneg _ _)] exact geometricMajorant_le_length _ _ private theorem integrable_circlePrefix (S : Finset ℤ) (L : ℕ) : Integrable (circlePrefix S L) AddCircle.haarAddCircle := by have hr (n : ℕ) : Integrable (fun x : UnitAddCircle => ‖sawCircle (((n + 1 : ℕ) : ℤ) • x) - circlePolynomial S (((n + 1 : ℕ) : ℤ) • x)‖) AddCircle.haarAddCircle := by have hp : MeasurePreserving (fun x : UnitAddCircle => ((n + 1 : ℕ) : ℤ) • x) AddCircle.haarAddCircle AddCircle.haarAddCircle := Measure.measurePreserving_zsmul AddCircle.haarAddCircle (by omega) simpa only [Function.comp_def] using hp.integrable_comp_of_integrable (integrable_circle_remainder S) have hrSum := integrable_finsetSum (Finset.range L) (fun n _ => hr n) have hgSum := integrable_finsetSum S (fun h _ => (integrable_circle_geometric L h).const_mul ‖coefficient h‖) change Integrable (fun x : UnitAddCircle => (∑ n ∈ Finset.range L, ‖sawCircle (((n + 1 : ℕ) : ℤ) • x) - circlePolynomial S (((n + 1 : ℕ) : ℤ) • x)‖) + ∑ h ∈ S, ‖coefficient h‖ * geometricMajorant L (fourier h x)) AddCircle.haarAddCircle exact hrSum.add hgSum /-- Integrability of the actual endpoint-valued prefix majorant. -/ theorem integrableOn_prefixMajorant (S : Finset ℤ) (L : ℕ) : IntegrableOn (prefixMajorant S L) (Icc (0 : ℝ) 1) := by simpa only [circlePrefix_coe] using integrable_lift (integrable_circlePrefix S L) private theorem integrableOn_remainderCost (S : Finset ℤ) (L : ℕ) : IntegrableOn (remainderCost S L) (Icc (0 : ℝ) 1) := by apply integrable_finsetSum intro n hn have hp : MeasurePreserving (fun x : UnitAddCircle => ((n + 1 : ℕ) : ℤ) • x) AddCircle.haarAddCircle AddCircle.haarAddCircle := Measure.measurePreserving_zsmul AddCircle.haarAddCircle (by omega) simpa only [IntegrableOn, Function.comp_def, ← AddCircle.coe_zsmul, zsmul_eq_mul, Int.cast_natCast, sawCircle_coe, circlePolynomial_coe] using integrable_lift (hp.integrable_comp_of_integrable (integrable_circle_remainder S)) /-- Positive integer samples are genuinely Haar-preserving, including at resonances. -/ theorem integral_remainderCost (S : Finset ℤ) (L : ℕ) : (∫ θ in Icc (0 : ℝ) 1, remainderCost S L θ) = (L : ℝ) * ∫ x : UnitAddCircle, ‖sawCircle x - circlePolynomial S x‖ ∂AddCircle.haarAddCircle := by have he (θ : ℝ) : remainderCost S L θ = ∑ n ∈ Finset.range L, ‖sawCircle (((n + 1 : ℕ) : ℤ) • (θ : UnitAddCircle)) - circlePolynomial S (((n + 1 : ℕ) : ℤ) • (θ : UnitAddCircle))‖ := by simp only [remainderCost, ← AddCircle.coe_zsmul, zsmul_eq_mul, Int.cast_natCast, sawCircle_coe, circlePolynomial_coe] simp_rw [he] rw [integral_lift (fun x : UnitAddCircle => ∑ n ∈ Finset.range L, ‖sawCircle (((n + 1 : ℕ) : ℤ) • x) - circlePolynomial S (((n + 1 : ℕ) : ℤ) • x)‖)] exact integral_sum_positive_rotations _ (integrable_circle_remainder S) L /-- The zero Fourier mode costs exactly zero; the two nonzero halves are harmonic. -/ theorem sum_norm_coefficient_le (H : ℕ) : (∑ h ∈ Finset.Icc (-(H : ℤ)) H, ‖coefficient h‖) ≤ 2 * (1 + Real.log H) := by have he : (fun h : ℤ => ‖coefficient h‖).Even := by intro h simp only [norm_coefficient, Int.cast_neg, abs_neg] have hz : ‖coefficient 0‖ = 0 := by simp [coefficient] rw [Finset.sum_Icc_of_even_eq_range he, Finset.sum_range_succ'] simp only [Nat.cast_zero, hz, add_zero, sub_zero, nsmul_eq_mul] have hn (n : ℕ) : ‖coefficient ((n + 1 : ℕ) : ℤ)‖ ≤ ((n + 1 : ℕ) : ℝ)⁻¹ := by have hp : 0 < ((n + 1 : ℕ) : ℝ) := by positivity rw [norm_coefficient] simp only [Int.cast_natCast, abs_of_nonneg hp.le] rw [← one_div] apply div_le_div_of_nonneg_left (by norm_num) hp nlinarith [Real.pi_gt_three] calc _ ≤ 2 * (harmonic H : ℝ) := by apply mul_le_mul_of_nonneg_left _ (by norm_num) simp only [harmonic, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast] exact Finset.sum_le_sum fun n _ => hn n _ ≤ 2 * (1 + Real.log H) := mul_le_mul_of_nonneg_left (harmonic_le_one_add_log H) (by norm_num) private theorem integrableOn_weighted_geometric (S : Finset ℤ) (L : ℕ) (h : ℤ) : IntegrableOn (fun θ => ‖coefficient h‖ * geometricMajorant L (phase h θ)) (Icc (0 : ℝ) 1) := by simpa only [phase_eq_fourier] using integrable_lift ((integrable_circle_geometric L h).const_mul ‖coefficient h‖) /-- A concrete universal prefix constant, with no discrepancy hypothesis. -/ theorem integral_prefixMajorant_le {L : ℕ} (hL : 1 ≤ L) : (∫ θ in Icc (0 : ℝ) 1, prefixMajorant (cutoffS L) L θ) ≤ 10 * (1 + Real.log L) ^ 2 := by have hp : 0 < (L : ℝ) := by exact_mod_cast (show 0 < L by omega) have hl : 0 ≤ Real.log L := Real.log_nonneg (by exact_mod_cast hL) have hrem : (∫ θ in Icc (0 : ℝ) 1, remainderCost (cutoffS L) L θ) ≤ 2 := by rw [integral_remainderCost] calc _ ≤ (L : ℝ) * (2 / Real.sqrt ((L ^ 2 : ℕ) : ℝ)) := mul_le_mul_of_nonneg_left (integral_circle_remainder_le (H := L ^ 2) (by nlinarith)) hp.le _ = 2 := by rw [Nat.cast_pow, Real.sqrt_sq hp.le] field_simp [hp.ne'] have hg : (∫ θ in Icc (0 : ℝ) 1, ∑ h ∈ cutoffS L, ‖coefficient h‖ * geometricMajorant L (phase h θ)) ≤ 8 * (1 + Real.log L) ^ 2 := by rw [integral_finsetSum _ (fun h _ => integrableOn_weighted_geometric (cutoffS L) L h)] calc _ ≤ ∑ h ∈ cutoffS L, ‖coefficient h‖ * (2 * (1 + Real.log L)) := by apply Finset.sum_le_sum intro h hh by_cases hz : h = 0 · subst h simp [coefficient] · rw [integral_const_mul] exact mul_le_mul_of_nonneg_left (integral_geometricMajorant_phase_le hL hz) (norm_nonneg _) _ = (∑ h ∈ cutoffS L, ‖coefficient h‖) * (2 * (1 + Real.log L)) := by rw [Finset.sum_mul] _ ≤ (2 * (1 + Real.log (L ^ 2 : ℕ))) * (2 * (1 + Real.log L)) := mul_le_mul_of_nonneg_right (sum_norm_coefficient_le (L ^ 2)) (by positivity) _ ≤ 8 * (1 + Real.log L) ^ 2 := by rw [Nat.cast_pow, Real.log_pow] norm_num nlinarith simp only [prefixMajorant] rw [integral_add (integrableOn_remainderCost _ _) (integrable_finsetSum (cutoffS L) fun h _ => integrableOn_weighted_geometric (cutoffS L) L h)] nlinarith [sq_nonneg (Real.log (L : ℝ))] /-- Reflection preserves the entire prefix average, not merely its polynomial part. -/ theorem integral_prefixMajorant_neg (S : Finset ℤ) (L : ℕ) : (∫ θ in Icc (0 : ℝ) 1, prefixMajorant S L (-θ)) = ∫ θ in Icc (0 : ℝ) 1, prefixMajorant S L θ := by have he (θ : ℝ) : prefixMajorant S L (-θ) = circlePrefix S L ((-1 : ℤ) • (θ : UnitAddCircle)) := by simp only [neg_one_zsmul, ← AddCircle.coe_neg, circlePrefix_coe] simp_rw [he, ← circlePrefix_coe] rw [integral_lift (fun x : UnitAddCircle => circlePrefix S L ((-1 : ℤ) • x)), integral_lift (circlePrefix S L)] exact integral_integer_rotation _ (integrable_circlePrefix S L).aestronglyMeasurable (by norm_num) private theorem integrableOn_prefixMajorant_neg (S : Finset ℤ) (L : ℕ) : IntegrableOn (fun θ => prefixMajorant S L (-θ)) (Icc (0 : ℝ) 1) := by have hp : MeasurePreserving (fun x : UnitAddCircle => (-1 : ℤ) • x) AddCircle.haarAddCircle AddCircle.haarAddCircle := Measure.measurePreserving_zsmul AddCircle.haarAddCircle (by norm_num) simpa only [Function.comp_def, neg_one_zsmul, ← AddCircle.coe_neg, circlePrefix_coe] using integrable_lift (hp.integrable_comp_of_integrable (integrable_circlePrefix S L)) /-- One actual majorant works simultaneously for every row. -/ def rowMajorant (L : ℕ) (θ : ℝ) : ℝ := 1 / 2 + prefixMajorant (cutoffS L) L θ + prefixMajorant (cutoffS L) L (-θ) theorem rowMajorant_nonneg (L : ℕ) (θ : ℝ) : 0 ≤ rowMajorant L θ := by unfold rowMajorant exact add_nonneg (add_nonneg (by norm_num) (prefixMajorant_nonneg (cutoffS L) L θ)) (prefixMajorant_nonneg (cutoffS L) L (-θ)) theorem row_error_le (θ : ℝ) {y L : ℕ} (hy : y < L) : |∑ r ∈ Finset.range L, (1 / 2 - Int.fract (θ * ((y : ℝ) - r)))| ≤ rowMajorant L θ := skew_centered_error_bound (cutoffS L) θ hy theorem measurable_prefixMajorant (S : Finset ℤ) (L : ℕ) : Measurable (prefixMajorant S L) := by have hs : Measurable saw := by unfold saw fun_prop have hp : Continuous (polynomial S) := by unfold polynomial phase fun_prop have hphase (h : ℤ) : Continuous (phase h) := by unfold phase fun_prop have hg := measurable_geometricMajorant L unfold prefixMajorant remainderCost fun_prop theorem measurable_rowMajorant (L : ℕ) : Measurable (rowMajorant L) := by have h := measurable_prefixMajorant (cutoffS L) L exact (measurable_const.add h).add (h.comp measurable_neg) theorem integrableOn_rowMajorant (L : ℕ) : IntegrableOn (rowMajorant L) (Icc (0 : ℝ) 1) := ((integrable_const (1 / 2 : ℝ)).add (integrableOn_prefixMajorant _ _)).add (integrableOn_prefixMajorant_neg _ _) /-- Uniform-row average with explicit universal constant 21. -/ theorem integral_rowMajorant_le {L : ℕ} (hL : 1 ≤ L) : (∫ θ in Icc (0 : ℝ) 1, rowMajorant L θ) ≤ 21 * (1 + Real.log L) ^ 2 := by have hl : 0 ≤ Real.log L := Real.log_nonneg (by exact_mod_cast hL) have h := integral_prefixMajorant_le hL simp only [rowMajorant] rw [integral_add (f := fun θ => 1 / 2 + prefixMajorant (cutoffS L) L θ) (g := fun θ => prefixMajorant (cutoffS L) L (-θ)) ((integrable_const (1 / 2 : ℝ)).add (integrableOn_prefixMajorant _ _)) (integrableOn_prefixMajorant_neg _ _), integral_add (f := fun _ => (1 / 2 : ℝ)) (g := prefixMajorant (cutoffS L) L) (integrable_const (1 / 2 : ℝ)) (integrableOn_prefixMajorant _ _), integral_prefixMajorant_neg] norm_num only [setIntegral_const, measureReal_def, Real.volume_Icc, sub_zero, ENNReal.ofReal_one, ENNReal.toReal_one, smul_eq_mul, one_mul] nlinarith [sq_nonneg (Real.log (L : ℝ))] /-- Restriction to the short interval uses the genuine reciprocal-length normalization. -/ theorem integrable_uniform_rowMajorant {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ ≤ 1) (L : ℕ) : Integrable (rowMajorant L) (uniformIntervalMeasure δ) := by apply Integrable.smul_measure ((integrableOn_rowMajorant L).mono_set (fun x hx => ⟨hx.1, hx.2.le.trans hδ1⟩)) exact ENNReal.inv_ne_top.mpr (ENNReal.ofReal_ne_zero_iff.mpr hδ) theorem integral_uniform_rowMajorant_le {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ ≤ 1) {L : ℕ} (hL : 1 ≤ L) : (∫ θ, rowMajorant L θ ∂uniformIntervalMeasure δ) ≤ (21 / δ) * (1 + Real.log L) ^ 2 := by rw [uniformIntervalMeasure, integral_smul_measure, ENNReal.toReal_inv, ENNReal.toReal_ofReal hδ.le, smul_eq_mul] have hi : (∫ θ in Ico (0 : ℝ) δ, rowMajorant L θ) ≤ ∫ θ in Icc (0 : ℝ) 1, rowMajorant L θ := by apply setIntegral_mono_set (integrableOn_rowMajorant L) (ae_of_all _ (rowMajorant_nonneg L)) exact ae_of_all _ fun x hx => ⟨hx.1, hx.2.le.trans hδ1⟩ calc _ ≤ δ⁻¹ * (21 * (1 + Real.log L) ^ 2) := mul_le_mul_of_nonneg_left (hi.trans (integral_rowMajorant_le hL)) (inv_nonneg.mpr hδ.le) _ = _ := by ring /-- A measurable bad-angle envelope; every row-error event is contained in it. -/ def badAngles (L : ℕ) (E : ℝ) : Set ℝ := {θ | E < rowMajorant L θ} theorem measurableSet_badAngles (L : ℕ) (E : ℝ) : MeasurableSet (badAngles L E) := measurableSet_lt measurable_const (measurable_rowMajorant L) theorem row_bad_subset (L y : ℕ) (hy : y < L) (E : ℝ) : {θ | E < |∑ r ∈ Finset.range L, (1 / 2 - Int.fract (θ * ((y : ℝ) - r)))|} ⊆ badAngles L E := fun θ hθ => hθ.trans_le (row_error_le θ hy) /-- Markov's inequality with the explicit log-squared average. -/ theorem badAngles_mass_le {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ ≤ 1) {L : ℕ} (hL : 1 ≤ L) {E : ℝ} (hE : 0 < E) : (uniformIntervalMeasure δ).real (badAngles L E) ≤ ((21 / δ) * (1 + Real.log L) ^ 2) / E := by letI := uniformIntervalMeasure_probability hδ have hm := mul_meas_ge_le_integral_of_nonneg (ae_of_all (uniformIntervalMeasure δ) (rowMajorant_nonneg L)) (integrable_uniform_rowMajorant hδ hδ1 L) E have hs : (uniformIntervalMeasure δ).real (badAngles L E) ≤ (uniformIntervalMeasure δ).real {θ | E ≤ rowMajorant L θ} := by apply measureReal_mono ?_ (by finiteness) intro θ hθ change E < rowMajorant L θ at hθ change E ≤ rowMajorant L θ exact hθ.le apply (le_div_iff₀ hE).mpr calc _ ≤ E * (uniformIntervalMeasure δ).real {θ | E ≤ rowMajorant L θ} := by simpa only [mul_comm] using mul_le_mul_of_nonneg_left hs hE.le _ ≤ _ := hm.trans (integral_uniform_rowMajorant_le hδ hδ1 hL) /-- Log squared divided by the manuscript's original power tends to zero. -/ theorem tendsto_log_squared_div_error : Tendsto (fun L : ℕ => (1 + Real.log L) ^ 2 / (L : ℝ) ^ (1 / 10 : ℝ)) atTop (𝓝 0) := by have hlog : Tendsto (fun x : ℝ => Real.log x / x ^ (1 / 20 : ℝ)) atTop (𝓝 0) := (isLittleO_log_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 20)).tendsto_div_nhds_zero have hinv : Tendsto (fun x : ℝ => 1 / x ^ (1 / 20 : ℝ)) atTop (𝓝 0) := by simpa only [one_div, Function.comp_def] using tendsto_inv_atTop_zero.comp (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 20)) have hs := ((hinv.add hlog).pow 2).comp tendsto_natCast_atTop_atTop norm_num only [zero_add, zero_pow] at hs apply hs.congr' filter_upwards [eventually_ge_atTop 1] with L hL have hp : 0 ≤ (L : ℝ) := Nat.cast_nonneg L have he : ((L : ℝ) ^ (1 / 20 : ℝ)) ^ (2 : ℕ) = (L : ℝ) ^ (1 / 10 : ℝ) := by rw [← Real.rpow_natCast, ← Real.rpow_mul hp] norm_num dsimp only [Function.comp_def] rw [← add_div, div_pow, he] /-- Vanishing exceptional probability for `E = L^(1/10)`, along natural L. -/ theorem tendsto_badAngles_mass {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ ≤ 1) : Tendsto (fun L : ℕ => (uniformIntervalMeasure δ).real (badAngles L ((L : ℝ) ^ (1 / 10 : ℝ)))) atTop (𝓝 0) := by have hu := tendsto_log_squared_div_error.const_mul (21 / δ) simp only [mul_zero] at hu apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds hu · exact Filter.Eventually.of_forall fun L => ENNReal.toReal_nonneg · filter_upwards [eventually_ge_atTop 1] with L hL have hp : 0 < (L : ℝ) := by exact_mod_cast (show 0 < L by omega) simpa only [mul_div_assoc] using badAngles_mass_le hδ hδ1 hL (Real.rpow_pos_of_pos hp _) end DistanceCounts.RotationAverage end end BodyFile078 -- Source: DistanceCounts/SkewParameters.lean section BodyFile079 /-! Canonical projection parameters and the simultaneous row-discrepancy event. -/ noncomputable section namespace DistanceCounts.SkewParameters open Set MeasureTheory def alpha (δ : ℝ) (a : ℝ × ℝ) : ℝ := 1 - δ + a.1 def beta (a : ℝ × ℝ) : ℝ := 1 + a.2 def gamma (a : ℝ × ℝ) : ℝ := -a.2 / 2 def eta (δ : ℝ) (a : ℝ × ℝ) : ℝ := (δ - a.1) / 2 /-- Both rows are controlled simultaneously; no event independence is claimed. -/ def good (δ : ℝ) (L : ℕ) (E : ℝ) : Set (ℝ × ℝ) := {a | a ∈ Icc (0 : ℝ) δ ×ˢ Icc (0 : ℝ) 1 ∧ RotationAverage.rowMajorant L a.2 ≤ E ∧ RotationAverage.rowMajorant L (δ - a.1) ≤ E} theorem measurableSet_good (δ : ℝ) (L : ℕ) (E : ℝ) : MeasurableSet (good δ L E) := by exact (measurableSet_Icc.prod measurableSet_Icc).inter ((measurableSet_le ((RotationAverage.measurable_rowMajorant L).comp measurable_snd) measurable_const).inter (measurableSet_le ((RotationAverage.measurable_rowMajorant L).comp (measurable_const.sub measurable_fst)) measurable_const)) theorem rowMajorant_neg (L : ℕ) (θ : ℝ) : RotationAverage.rowMajorant L (-θ) = RotationAverage.rowMajorant L θ := by unfold RotationAverage.rowMajorant rw [neg_neg] ring end DistanceCounts.SkewParameters end end BodyFile079 -- Source: DistanceCounts/SkewGadget.lean section BodyFile080 /-! Exact parity-safe skew-gadget counts and their floor-sum decomposition. -/ noncomputable section open scoped BigOperators namespace DistanceCounts namespace SkewGadget /-- The integer upper endpoint in a row of the parity-safe gadget. -/ def endpoint (γ : ℝ) (y : ℤ) (r : ℕ) : ℤ := ⌊2 * γ * ((y : ℝ) - (r : ℝ))⌋ /-- Actual horizontal indices, together with their row. The matching indices on the other side are `j = x-k` and `h = y-r`. -/ def pairIndices (L : ℕ) (γ : ℝ) (x y : ℤ) : Finset (Σ _ : ℕ, ℤ) := (Finset.range L).sigma fun r => Finset.Icc (x - 4 * (L : ℤ)) (endpoint γ y r) def floorSum (L : ℕ) (γ : ℝ) (y : ℤ) : ℤ := ∑ r ∈ Finset.range L, endpoint γ y r def centeredError (L : ℕ) (γ : ℝ) (y : ℤ) : ℝ := ∑ r ∈ Finset.range L, (1 / 2 - Int.fract (2 * γ * ((y : ℝ) - (r : ℝ)))) /-- Floor sums split exactly, including the half-unit centering term. No discrepancy estimate is used in this algebraic identity. -/ theorem floorSum_decomposition (L : ℕ) (γ : ℝ) (y : ℤ) : (floorSum L γ y : ℝ) = 2 * γ * L * y - γ * L * ((L : ℝ) - 1) - (L : ℝ) / 2 + centeredError L γ y := by induction L with | zero => simp [floorSum, centeredError] | succ L ih => simp only [floorSum, Finset.sum_range_succ, Int.cast_add] at ih ⊢ simp only [centeredError, Finset.sum_range_succ] at ih ⊢ have hf := Int.floor_add_fract (2 * γ * ((y : ℝ) - (L : ℝ))) dsimp [endpoint] at * push_cast at ih ⊢ nlinarith [ih, hf] /-- The exact integer count; the hypothesis says precisely that none of the intervals has been truncated by `toNat`. -/ theorem pairIndices_card_of_endpoints (L : ℕ) (γ : ℝ) (x y : ℤ) (h : ∀ r ∈ Finset.range L, x - 4 * (L : ℤ) ≤ endpoint γ y r + 1) : ((pairIndices L γ x y).card : ℤ) = 4 * (L : ℤ) ^ 2 + L - L * x + floorSum L γ y := by rw [pairIndices, Finset.card_sigma, Nat.cast_sum] calc (∑ r ∈ Finset.range L, ((Finset.Icc (x - 4 * (L : ℤ)) (endpoint γ y r)).card : ℤ)) = ∑ r ∈ Finset.range L, (endpoint γ y r + 1 - (x - 4 * (L : ℤ))) := by apply Finset.sum_congr rfl intro r hr exact Int.card_Icc_of_le _ _ (h r hr) _ = 4 * (L : ℤ) ^ 2 + L - L * x + floorSum L γ y := by simp [Finset.sum_sub_distrib, Finset.sum_add_distrib, floorSum] ring /-- Floor endpoint bounds valid over the entire parameter interval. -/ theorem endpoint_bounds (L : ℕ) (γ : ℝ) (y : ℤ) (r : ℕ) (hγ : -(1 / 2 : ℝ) ≤ γ ∧ γ ≤ 1 / 2) (hy : 0 ≤ y ∧ y < (L : ℤ)) (hr : r < L) : -(L : ℤ) ≤ endpoint γ y r ∧ endpoint γ y r ≤ (L : ℤ) := by have hyR : 0 ≤ (y : ℝ) ∧ (y : ℝ) < (L : ℝ) := by exact_mod_cast hy have hrR : (r : ℝ) < (L : ℝ) := by exact_mod_cast hr have habsγ : |2 * γ| ≤ 1 := abs_le.mpr (by constructor <;> linarith [hγ.1, hγ.2]) have habsh : |(y : ℝ) - r| ≤ (L : ℝ) := abs_le.mpr (by constructor <;> linarith [hyR.1, hyR.2, Nat.cast_nonneg (α := ℝ) r]) have habs : |2 * γ * ((y : ℝ) - r)| ≤ (L : ℝ) := by rw [abs_mul] calc |2 * γ| * |(y : ℝ) - r| ≤ 1 * (L : ℝ) := mul_le_mul habsγ habsh (abs_nonneg _) (by norm_num) _ = _ := one_mul _ have hlo := (abs_le.mp habs).1 have hhi := (abs_le.mp habs).2 constructor · apply Int.le_floor.mpr simpa using hlo · apply Int.floor_le_iff.mpr push_cast linarith /-- Membership agrees with the original two rectangles, after solving the two midpoint equations. In particular the original `-6L` bound is inactive. -/ theorem mem_pairIndices_iff (L : ℕ) (γ : ℝ) (x y k : ℤ) (r : ℕ) (hγ : -(1 / 2 : ℝ) ≤ γ ∧ γ ≤ 1 / 2) (hx : 0 ≤ x ∧ x < (L : ℤ)) (hy : 0 ≤ y ∧ y < (L : ℤ)) : (⟨r, k⟩ : Σ _ : ℕ, ℤ) ∈ pairIndices L γ x y ↔ r < L ∧ -(4 * (L : ℤ)) ≤ x - k ∧ x - k ≤ 4 * (L : ℤ) ∧ -(L : ℤ) + 1 ≤ y - r ∧ y - r ≤ (L : ℤ) - 1 ∧ -(6 * (L : ℤ)) ≤ k ∧ k ≤ endpoint γ y r := by simp only [pairIndices, Finset.mem_sigma, Finset.mem_range, Finset.mem_Icc] constructor · rintro ⟨hr, hklo, hkhi⟩ have hb := endpoint_bounds L γ y r hγ hy hr have hrZ : (r : ℤ) < (L : ℤ) := by exact_mod_cast hr have hr0 : (0 : ℤ) ≤ r := Int.natCast_nonneg r omega · rintro ⟨hr, _, hj, _, _, _, hk⟩ exact ⟨hr, by omega, hk⟩ /-- Formula (17), as the cardinality of the actual matching index set. -/ theorem pairIndices_card (L : ℕ) (γ : ℝ) (x y : ℤ) (hγ : -(1 / 2 : ℝ) ≤ γ ∧ γ ≤ 1 / 2) (hx : 0 ≤ x ∧ x < (L : ℤ)) (hy : 0 ≤ y ∧ y < (L : ℤ)) : ((pairIndices L γ x y).card : ℤ) = 4 * (L : ℤ) ^ 2 + L - L * x + floorSum L γ y := by apply pairIndices_card_of_endpoints intro r hr have hb := endpoint_bounds L γ y r hγ hy (Finset.mem_range.mp hr) omega /-- The affine formula in §5, with its exactly defined fractional-part error. -/ theorem pairIndices_affine (L : ℕ) (γ : ℝ) (x y : ℤ) (hγ : -(1 / 2 : ℝ) ≤ γ ∧ γ ≤ 1 / 2) (hx : 0 ≤ x ∧ x < (L : ℤ)) (hy : 0 ≤ y ∧ y < (L : ℤ)) : ((pairIndices L γ x y).card : ℝ) = (4 * (L : ℝ) ^ 2 + (L : ℝ) / 2 - γ * L * ((L : ℝ) - 1)) - L * x + 2 * γ * L * y + centeredError L γ y := by have hc := pairIndices_card L γ x y hγ hx hy have hcR := congrArg (fun z : ℤ => (z : ℝ)) hc push_cast at hcR rw [floorSum_decomposition] at hcR nlinarith [hcR] end SkewGadget end DistanceCounts end end BodyFile080 -- Source: DistanceCounts/SkewGadgetRealization.lean section BodyFile081 noncomputable section namespace DistanceCounts.SkewGadgetRealization open OffsetSeparation CoarseGrid /-- Half-coordinates of the actual even rectangular array. -/ def arrayA (L : ℕ) : Finset (ℤ × ℤ) := (Finset.Icc (-(4 * (L : ℤ))) (4 * (L : ℤ))).product (Finset.Ico 0 (L : ℤ)) /-- Half-coordinates of the actual even skew array. -/ def arrayB (L : ℕ) (γ : ℝ) : Finset (ℤ × ℤ) := (Finset.Icc (-(L : ℤ) + 1) ((L : ℤ) - 1)).biUnion fun h => (Finset.Icc (-(6 * (L : ℤ))) ⌊2 * γ * (h : ℝ)⌋).image fun k => (k, h) def evenArray (U : Finset (ℤ × ℤ)) : Finset (ℤ × ℤ) := U.image (fun w => (2 * w.1, 2 * w.2)) /-- Coordinate interchange acts on the integer arrays only. -/ def transpose (U : Finset (ℤ × ℤ)) : Finset (ℤ × ℤ) := U.image Prod.swap def left {t : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (U : Finset (ℤ × ℤ)) : Finset ℝ := by classical exact (Finset.univ.product U).image (fun w : Fin t × (ℤ × ℤ) => project (blockPoint p z (.inl w.1) w.2)) def right {t : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (V : Finset (ℤ × ℤ)) : Finset ℝ := by classical exact (Finset.univ.product V).image (fun w : Fin t × (ℤ × ℤ) => project (blockPoint p z (.inr w.1) w.2)) def arrayPairs (U V : Finset (ℤ × ℤ)) (w : ℤ × ℤ) : Finset ((ℤ × ℤ) × (ℤ × ℤ)) := (U.product V).filter (fun q => q.1 + q.2 = w) private theorem block_injective {I : Type*} [Fintype I] [DecidableEq I] (p : I → ℕ) (z : I → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) : Function.Injective (fun w : I × (ℤ × ℤ) => project (blockPoint p z w.1 w.2)) := by rintro ⟨i, v⟩ ⟨j, w⟩ he have heq := project_injective he have hpair : rationalOffset (z i) (p i) + rationalOffset (z i) (p i) + integerVector (2 * v.1, 2 * v.2) = rationalOffset (z j) (p j) + rationalOffset (z j) (p j) + integerVector (2 * w.1, 2 * w.2) := by apply Prod.ext · have h := congrArg Prod.fst heq simp [blockPoint] at h simp [integerVector] linarith · have h := congrArg Prod.snd heq simp [blockPoint] at h simp [integerVector] linarith have hi : i = j := by have h := offset_pair_separation p z hp hd hz (fun k => inert_gt_two _ (hp k) (hinert k)) i i j j _ _ hpair rcases h with h | h <;> exact h.1 subst j have hvw : v = w := by apply Prod.ext · have h : 2 * ((rationalOffset (z i) (p i)).1 + (v.1 : ℚ)) = 2 * ((rationalOffset (z i) (p i)).1 + (w.1 : ℚ)) := congrArg Prod.fst heq have hv : (v.1 : ℚ) = (w.1 : ℚ) := by linarith only [h] exact_mod_cast hv · have h : 2 * ((rationalOffset (z i) (p i)).2 + (v.2 : ℚ)) = 2 * ((rationalOffset (z i) (p i)).2 + (w.2 : ℚ)) := congrArg Prod.snd heq have hv : (v.2 : ℚ) = (w.2 : ℚ) := by linarith only [h] exact_mod_cast hv exact congrArg (fun v : ℤ × ℤ => (i, v)) hvw private theorem midpoint_iff {t : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (i a j b : Fin t) (v u w : ℤ × ℤ) : project (blockPoint p z (.inl i) v) + project (blockPoint p z (.inr j) u) = 2 * project (rationalPin p z a b w.1 w.2) ↔ i = a ∧ j = b ∧ v + u = w := by rw [← project_add, ← twice_pin] constructor · intro h have he := project_injective h have hab := row_column_unique p z hp hd hz hinert i a j b v u w he refine ⟨hab.1, hab.2, ?_⟩ rcases hab with ⟨rfl, rfl⟩ apply Prod.ext · have h := congrArg Prod.fst he simp [blockPoint] at h exact_mod_cast (show (v.1 : ℚ) + u.1 = w.1 by linarith) · have h := congrArg Prod.snd he simp [blockPoint] at h exact_mod_cast (show (v.2 : ℚ) + u.2 = w.2 by linarith) · rintro ⟨rfl, rfl, hw⟩ apply congrArg project apply Prod.ext · have h := congrArg Prod.fst hw simp only [Prod.fst_add] at h simp [blockPoint, ← h] ring · have h := congrArg Prod.snd hw simp only [Prod.snd_add] at h simp [blockPoint, ← h] ring theorem controls_disjoint {t : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (U V : Finset (ℤ × ℤ)) : Disjoint (left p z U) (right p z V) := by classical apply Finset.disjoint_left.mpr intro s hs ht unfold left at hs unfold right at ht obtain ⟨⟨i, v⟩, _, he⟩ := Finset.mem_image.mp hs obtain ⟨⟨j, w⟩, _, hf⟩ := Finset.mem_image.mp ht have h : ((Sum.inl i, v) : (Fin t ⊕ Fin t) × (ℤ × ℤ)) = (Sum.inr j, w) := block_injective p z hp hd hz hinert (a₁ := (Sum.inl i, v)) (a₂ := (Sum.inr j, w)) (he.trans hf.symm) have hij : (Sum.inl i : Fin t ⊕ Fin t) = Sum.inr j := congrArg Prod.fst h cases hij theorem left_sum_ne {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (U : Finset (ℤ × ℤ)) (q : PinIndex t L) {s r : ℝ} (hs : s ∈ left p z U) (hr : r ∈ left p z U) : s + r ≠ 2 * lineProjection direction (pin p z q) := by classical obtain ⟨⟨i, v⟩, _, rfl⟩ := Finset.mem_image.mp hs obtain ⟨⟨j, w⟩, _, rfl⟩ := Finset.mem_image.mp hr rw [pin, projection_embed, ← project_add, ← twice_pin] intro h exact row_row_exclusion p z hp hd hz hinert i j q.1.1 q.1.2 v w (q.2.1, q.2.2) (project_injective h) theorem right_sum_ne {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (V : Finset (ℤ × ℤ)) (q : PinIndex t L) {s r : ℝ} (hs : s ∈ right p z V) (hr : r ∈ right p z V) : s + r ≠ 2 * lineProjection direction (pin p z q) := by classical obtain ⟨⟨i, v⟩, _, rfl⟩ := Finset.mem_image.mp hs obtain ⟨⟨j, w⟩, _, rfl⟩ := Finset.mem_image.mp hr rw [pin, projection_embed, ← project_add, ← twice_pin] intro h exact column_column_exclusion p z hp hd hz hinert q.1.1 i j q.1.2 v w (q.2.1, q.2.2) (project_injective h) theorem cross_card {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (U V : Finset (ℤ × ℤ)) (q : PinIndex t L) : (crossMidpointPairs (planePoint (lineProjection direction (pin p z q)) 0) (left p z U) (right p z V)).card = (arrayPairs U V (q.2.1, q.2.2)).card := by classical symm apply Finset.card_bij (fun (w : (ℤ × ℤ) × (ℤ × ℤ)) _ => (project (blockPoint p z (.inl q.1.1) w.1), project (blockPoint p z (.inr q.1.2) w.2))) · intro w hw obtain ⟨hUV, hsum⟩ := Finset.mem_filter.mp hw obtain ⟨hu, hv⟩ := Finset.mem_product.mp hUV apply Finset.mem_filter.mpr refine ⟨Finset.mem_product.mpr ⟨?_, ?_⟩, ?_⟩ · exact Finset.mem_image.mpr ⟨(q.1.1, w.1), by simp [hu], rfl⟩ · exact Finset.mem_image.mpr ⟨(q.1.2, w.2), by simp [hv], rfl⟩ · change _ = 2 * lineProjection direction (pin p z q) rw [pin, projection_embed] exact (midpoint_iff p z hp hd hz hinert _ _ _ _ _ _ _).mpr ⟨rfl, rfl, hsum⟩ · intro v hv w hw he refine Prod.ext ?_ ?_ · change v.1 = w.1 exact congrArg (fun a : (Fin t ⊕ Fin t) × (ℤ × ℤ) => a.2) (block_injective p z hp hd hz hinert (a₁ := (Sum.inl q.1.1, v.1)) (a₂ := (Sum.inl q.1.1, w.1)) (congrArg Prod.fst he)) · change v.2 = w.2 have hright : ((Sum.inr q.1.2, v.2) : (Fin t ⊕ Fin t) × (ℤ × ℤ)) = (Sum.inr q.1.2, w.2) := block_injective p z hp hd hz hinert (a₁ := (Sum.inr q.1.2, v.2)) (a₂ := (Sum.inr q.1.2, w.2)) (congrArg Prod.snd he) exact congrArg (fun a : (Fin t ⊕ Fin t) × (ℤ × ℤ) => a.2) hright · intro s hs have hs' : s ∈ ((left p z U).product (right p z V)).filter (fun ab : ℝ × ℝ => ab.1 + ab.2 = 2 * lineProjection direction (pin p z q)) := hs have hAB : s ∈ (left p z U).product (right p z V) := (Finset.mem_filter.mp hs').1 have hsum : s.1 + s.2 = 2 * lineProjection direction (pin p z q) := (Finset.mem_filter.mp hs').2 have ha : s.1 ∈ (Finset.univ.product U).image (fun a : Fin t × (ℤ × ℤ) => project (blockPoint p z (.inl a.1) a.2)) := (Finset.mem_product.mp hAB).1 have hb : s.2 ∈ (Finset.univ.product V).image (fun a : Fin t × (ℤ × ℤ) => project (blockPoint p z (.inr a.1) a.2)) := (Finset.mem_product.mp hAB).2 obtain ⟨⟨i, v⟩, hiv, he⟩ := Finset.mem_image.mp ha obtain ⟨⟨j, w⟩, hjw, hf⟩ := Finset.mem_image.mp hb have hv : v ∈ U := (Finset.mem_product.mp hiv).2 have hw : w ∈ V := (Finset.mem_product.mp hjw).2 change project (blockPoint p z (.inl i) v) = s.1 at he change project (blockPoint p z (.inr j) w) = s.2 at hf have hmid : project (blockPoint p z (.inl i) v) + project (blockPoint p z (.inr j) w) = 2 * project (rationalPin p z q.1.1 q.1.2 q.2.1 q.2.2) := by rw [pin, projection_embed] at hsum exact (congrArg₂ (fun a b : ℝ => a + b) he hf).trans hsum have hmatch : i = q.1.1 ∧ j = q.1.2 ∧ v + w = ((q.2.1 : ℤ), (q.2.2 : ℤ)) := (midpoint_iff p z hp hd hz hinert i q.1.1 j q.1.2 v w ((q.2.1 : ℤ), (q.2.2 : ℤ))).mp hmid have hUV : (v, w) ∈ U.product V := Finset.mem_product.mpr ⟨hv, hw⟩ have hpair : (v, w) ∈ arrayPairs U V (q.2.1, q.2.2) := Finset.mem_filter.mpr ⟨hUV, hmatch.2.2⟩ refine ⟨(v, w), hpair, ?_⟩ rw [hmatch.1] at he rw [hmatch.2.1] at hf exact Prod.ext he hf theorem controls_card_le {t : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (U V : Finset (ℤ × ℤ)) : (left p z U).card + (right p z V).card ≤ t * (U.card + V.card) := by classical have ha : (left p z U).card ≤ t * U.card := by exact (Finset.card_image_le).trans_eq (by simp) have hb : (right p z V).card ≤ t * V.card := by exact (Finset.card_image_le).trans_eq (by simp) simpa only [Nat.mul_add] using Nat.add_le_add ha hb theorem mem_arrayA (L : ℕ) (w : ℤ × ℤ) : w ∈ arrayA L ↔ -(4 * (L : ℤ)) ≤ w.1 ∧ w.1 ≤ 4 * (L : ℤ) ∧ 0 ≤ w.2 ∧ w.2 < (L : ℤ) := by simp only [arrayA, Finset.product_eq_sprod, Finset.mem_product, Finset.mem_Icc, Finset.mem_Ico] tauto theorem mem_arrayB (L : ℕ) (γ : ℝ) (w : ℤ × ℤ) : w ∈ arrayB L γ ↔ -(L : ℤ) + 1 ≤ w.2 ∧ w.2 ≤ (L : ℤ) - 1 ∧ -(6 * (L : ℤ)) ≤ w.1 ∧ w.1 ≤ ⌊2 * γ * (w.2 : ℝ)⌋ := by constructor · intro hw obtain ⟨h, hh, hk⟩ := Finset.mem_biUnion.mp hw obtain ⟨k, hk, he⟩ := Finset.mem_image.mp hk have hh' := Finset.mem_Icc.mp hh have hk' := Finset.mem_Icc.mp hk cases he exact ⟨hh'.1, hh'.2, hk'.1, hk'.2⟩ · rintro ⟨ha, hb, hc, hd⟩ exact Finset.mem_biUnion.mpr ⟨w.2, Finset.mem_Icc.mpr ⟨ha, hb⟩, Finset.mem_image.mpr ⟨w.1, Finset.mem_Icc.mpr ⟨hc, hd⟩, rfl⟩⟩ /-- The arrays are literally even integer points, with the stated inequalities. -/ theorem mem_evenArray (U : Finset (ℤ × ℤ)) (w : ℤ × ℤ) : w ∈ evenArray U ↔ ∃ v ∈ U, (2 * v.1, 2 * v.2) = w := by exact Finset.mem_image theorem arrayPairs_card (L : ℕ) (γ : ℝ) (x y : ℤ) (hγ : -(1 / 2 : ℝ) ≤ γ ∧ γ ≤ 1 / 2) (hx : 0 ≤ x ∧ x < (L : ℤ)) (hy : 0 ≤ y ∧ y < (L : ℤ)) : (arrayPairs (arrayA L) (arrayB L γ) (x, y)).card = (SkewGadget.pairIndices L γ x y).card := by classical symm apply Finset.card_bij (fun (q : Σ _ : ℕ, ℤ) _ => ((x - q.2, (q.1 : ℤ)), (q.2, y - (q.1 : ℤ)))) · rintro ⟨r, k⟩ hq obtain ⟨hr, hjlo, hjhi, hhlo, hhhi, hklo, hkhi⟩ := (SkewGadget.mem_pairIndices_iff L γ x y k r hγ hx hy).mp hq apply Finset.mem_filter.mpr refine ⟨Finset.mem_product.mpr ⟨?_, ?_⟩, ?_⟩ · rw [mem_arrayA] dsimp only exact ⟨hjlo, hjhi, Int.natCast_nonneg r, by exact_mod_cast hr⟩ · rw [mem_arrayB] dsimp only refine ⟨hhlo, hhhi, hklo, ?_⟩ simpa [SkewGadget.endpoint] using hkhi · apply Prod.ext <;> simp · rintro ⟨r, k⟩ hr ⟨s, l⟩ hs he have hrow := congrArg (fun q : (ℤ × ℤ) × (ℤ × ℤ) => q.1.2) he have hcol := congrArg (fun q : (ℤ × ℤ) × (ℤ × ℤ) => q.2.1) he change (r : ℤ) = (s : ℤ) at hrow change k = l at hcol have hrs : r = s := by exact_mod_cast hrow subst s have hkl : k = l := hcol subst l rfl · rintro ⟨v, w⟩ hq obtain ⟨hUV, hsum⟩ := Finset.mem_filter.mp hq obtain ⟨hv, hw⟩ := Finset.mem_product.mp hUV obtain ⟨hjlo, hjhi, hrlo, hrhi⟩ := (mem_arrayA L v).mp hv obtain ⟨hhlo, hhhi, hklo, hkhi⟩ := (mem_arrayB L γ w).mp hw have hxs := congrArg Prod.fst hsum have hys := congrArg Prod.snd hsum simp only [Prod.fst_add, Prod.snd_add] at hxs hys have hr : (v.2.toNat : ℤ) = v.2 := Int.toNat_of_nonneg hrlo refine ⟨⟨v.2.toNat, w.1⟩, ?_, ?_⟩ · rw [SkewGadget.mem_pairIndices_iff L γ x y w.1 v.2.toNat hγ hx hy] have hj : x - w.1 = v.1 := by omega have hh : y - (v.2.toNat : ℤ) = w.2 := by omega refine ⟨by omega, ?_, ?_, ?_, ?_, hklo, ?_⟩ · rw [hj] exact hjlo · rw [hj] exact hjhi · rw [hr] have hh' : y - v.2 = w.2 := by omega rw [hh'] exact hhlo · rw [hr] have hh' : y - v.2 = w.2 := by omega rw [hh'] exact hhhi · have hhR : (y : ℝ) - (v.2.toNat : ℝ) = (w.2 : ℝ) := by exact_mod_cast hh simpa only [SkewGadget.endpoint, hhR] using hkhi · apply Prod.ext <;> apply Prod.ext <;> dsimp <;> omega theorem transpose_arrayPairs_card (U V : Finset (ℤ × ℤ)) (x y : ℤ) : (arrayPairs (transpose U) (transpose V) (x, y)).card = (arrayPairs U V (y, x)).card := by classical symm apply Finset.card_bij (fun (q : (ℤ × ℤ) × (ℤ × ℤ)) _ => (q.1.swap, q.2.swap)) · intro q hq obtain ⟨hUV, hsum⟩ := Finset.mem_filter.mp hq obtain ⟨hu, hv⟩ := Finset.mem_product.mp hUV refine Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨Finset.mem_image.mpr ⟨q.1, hu, rfl⟩, Finset.mem_image.mpr ⟨q.2, hv, rfl⟩⟩, ?_⟩ exact congrArg Prod.swap hsum · intro q hq r hr he have h := congrArg (fun q : (ℤ × ℤ) × (ℤ × ℤ) => (q.1.swap, q.2.swap)) he simpa using h · rintro ⟨u', v'⟩ hq obtain ⟨hUV, hsum⟩ := Finset.mem_filter.mp hq obtain ⟨hu, hv⟩ := Finset.mem_product.mp hUV change u' ∈ U.image Prod.swap at hu change v' ∈ V.image Prod.swap at hv obtain ⟨u, hu, heu⟩ := Finset.mem_image.mp hu obtain ⟨v, hv, hev⟩ := Finset.mem_image.mp hv change u' + v' = (x, y) at hsum rw [← heu, ← hev] at hsum refine ⟨(u, v), Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨hu, hv⟩, ?_⟩, Prod.ext heu hev⟩ simpa using congrArg Prod.swap hsum private theorem skew_floor_le (L : ℕ) (γ : ℝ) (hγ : -(1 / 2 : ℝ) ≤ γ ∧ γ ≤ 1 / 2) (h : ℤ) (hh : -(L : ℤ) + 1 ≤ h ∧ h ≤ (L : ℤ) - 1) : ⌊2 * γ * (h : ℝ)⌋ ≤ (L : ℤ) := by have ha : |2 * γ| ≤ 1 := abs_le.mpr (by constructor <;> linarith [hγ.1, hγ.2]) have hb : |(h : ℝ)| ≤ (L : ℝ) := by rw [abs_le] constructor · exact_mod_cast (show -(L : ℤ) ≤ h by omega) · exact_mod_cast (show h ≤ (L : ℤ) by omega) have hc : |2 * γ * (h : ℝ)| ≤ (L : ℝ) := by rw [abs_mul] simpa using mul_le_mul ha hb (abs_nonneg _) (by norm_num : (0 : ℝ) ≤ 1) apply Int.floor_le_iff.mpr have := (abs_le.mp hc).2 push_cast linarith theorem arrays_card_le (L : ℕ) (hL : 0 < L) (γ : ℝ) (hγ : -(1 / 2 : ℝ) ≤ γ ∧ γ ≤ 1 / 2) : (arrayA L).card + (arrayB L γ).card ≤ 25 * L ^ 2 := by have ha : (arrayA L).card = (8 * L + 1) * L := by rw [arrayA, Finset.product_eq_sprod, Finset.card_product, Int.card_Icc, Int.card_Ico] congr 1 <;> omega have hb : arrayB L γ ⊆ (Finset.Icc (-(6 * (L : ℤ))) (L : ℤ)).product (Finset.Icc (-(L : ℤ) + 1) ((L : ℤ) - 1)) := by intro w hw obtain ⟨hhlo, hhhi, hklo, hkhi⟩ := (mem_arrayB L γ w).mp hw exact Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨hklo, hkhi.trans (skew_floor_le L γ hγ w.2 ⟨hhlo, hhhi⟩)⟩, Finset.mem_Icc.mpr ⟨hhlo, hhhi⟩⟩ have hbcard : (arrayB L γ).card ≤ (7 * L + 1) * (2 * L - 1) := by apply (Finset.card_le_card hb).trans_eq rw [Finset.product_eq_sprod, Finset.card_product, Int.card_Icc, Int.card_Icc] congr 1 <;> omega rw [ha] have hsub : 2 * L - 1 + 1 = 2 * L := by omega nlinarith theorem gadget_controls_card_le {t : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (L : ℕ) (hL : 0 < L) (γ : ℝ) (hγ : -(1 / 2 : ℝ) ≤ γ ∧ γ ≤ 1 / 2) : (left p z (arrayA L)).card + (right p z (arrayB L γ)).card ≤ 25 * t * L ^ 2 := by calc _ ≤ t * ((arrayA L).card + (arrayB L γ).card) := controls_card_le p z _ _ _ ≤ t * (25 * L ^ 2) := Nat.mul_le_mul_left _ (arrays_card_le L hL γ hγ) _ = _ := by ring theorem transpose_controls_card_le {t : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (L : ℕ) (hL : 0 < L) (γ : ℝ) (hγ : -(1 / 2 : ℝ) ≤ γ ∧ γ ≤ 1 / 2) : (left p z (transpose (arrayA L))).card + (right p z (transpose (arrayB L γ))).card ≤ 25 * t * L ^ 2 := by have hU : (transpose (arrayA L)).card ≤ (arrayA L).card := Finset.card_image_le have hV : (transpose (arrayB L γ)).card ≤ (arrayB L γ).card := Finset.card_image_le calc _ ≤ t * ((transpose (arrayA L)).card + (transpose (arrayB L γ)).card) := controls_card_le p z _ _ _ ≤ t * ((arrayA L).card + (arrayB L γ).card) := Nat.mul_le_mul_left _ (Nat.add_le_add hU hV) _ ≤ t * (25 * L ^ 2) := Nat.mul_le_mul_left _ (arrays_card_le L hL γ hγ) _ = _ := by ring /-- Generic array realization; separation is proved, not assumed. -/ theorem exists_array_extension {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (U V : Finset (ℤ × ℤ)) (X : Finset Point) (hPX : pins L p z ⊆ X) : ∃ Y : Finset Point, X ⊆ Y ∧ Y.card = X.card + (left p z U).card + (right p z V).card ∧ ∀ q : PinIndex t L, pinnedCount Y (pin p z q) + (arrayPairs U V (q.2.1, q.2.2)).card = pinnedCount X (pin p z q) + (left p z U).card + (right p z V).card := by classical obtain ⟨Y, hXY, hcard, hcount⟩ := exists_oblique_line_extension direction_ne_zero (pins L p z) X (left p z U) (right p z V) hPX (controls_disjoint p z hp hd hz hinert U V) (by intro a ha s hs r hr _ obtain ⟨q, _, rfl⟩ := Finset.mem_image.mp ha exact left_sum_ne p z hp hd hz hinert U q hs hr) (by intro a ha s hs r hr _ obtain ⟨q, _, rfl⟩ := Finset.mem_image.mp ha exact right_sum_ne p z hp hd hz hinert V q hs hr) refine ⟨Y, hXY, hcard, ?_⟩ intro q have h := hcount (pin p z q) (pin_mem p z q) rw [cross_card p z hp hd hz hinert U V q] at h exact h theorem exists_skew_extension {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (hL : 0 < L) (γ : ℝ) (hγ : -(1 / 2 : ℝ) ≤ γ ∧ γ ≤ 1 / 2) (X : Finset Point) (hPX : pins L p z ⊆ X) : ∃ (Y : Finset Point) (C : ℕ), X ⊆ Y ∧ Y.card = X.card + C ∧ C ≤ 25 * t * L ^ 2 ∧ ∀ q : PinIndex t L, pinnedCount Y (pin p z q) + (SkewGadget.pairIndices L γ q.2.1 q.2.2).card = pinnedCount X (pin p z q) + C := by obtain ⟨Y, hXY, hcard, hcount⟩ := exists_array_extension p z hp hd hz hinert (arrayA L) (arrayB L γ) X hPX refine ⟨Y, (left p z (arrayA L)).card + (right p z (arrayB L γ)).card, hXY, by omega, gadget_controls_card_le p z L hL γ hγ, ?_⟩ intro q have h := hcount q rw [arrayPairs_card L γ q.2.1 q.2.2 hγ ⟨by positivity, by exact_mod_cast q.2.1.isLt⟩ ⟨by positivity, by exact_mod_cast q.2.2.isLt⟩] at h omega /-- Two actual line extensions. The old configuration is retained in its entirety. Only the integer arrays are transposed in the second extension. -/ theorem exists_two_skew_extensions {t L : ℕ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (hL : 0 < L) (γ η : ℝ) (hγ : -(1 / 2 : ℝ) ≤ γ ∧ γ ≤ 1 / 2) (hη : -(1 / 2 : ℝ) ≤ η ∧ η ≤ 1 / 2) (X : Finset Point) (hPX : pins L p z ⊆ X) : ∃ (Y : Finset Point) (C : ℕ), X ⊆ Y ∧ Y.card = X.card + C ∧ C ≤ 50 * t * L ^ 2 ∧ ∀ q : PinIndex t L, pinnedCount Y (pin p z q) + (SkewGadget.pairIndices L γ q.2.1 q.2.2).card + (SkewGadget.pairIndices L η q.2.2 q.2.1).card = pinnedCount X (pin p z q) + C := by obtain ⟨Z, C, hXZ, hZcard, hC, hZcount⟩ := exists_skew_extension p z hp hd hz hinert hL γ hγ X hPX obtain ⟨Y, hZY, hYcard, hYcount⟩ := exists_array_extension p z hp hd hz hinert (transpose (arrayA L)) (transpose (arrayB L η)) Z (hPX.trans hXZ) let D := (left p z (transpose (arrayA L))).card + (right p z (transpose (arrayB L η))).card have hD : D ≤ 25 * t * L ^ 2 := transpose_controls_card_le p z L hL η hη refine ⟨Y, C + D, hXZ.trans hZY, by dsimp [D]; omega, ?_, ?_⟩ · have he : 50 * t * L ^ 2 = 25 * t * L ^ 2 + 25 * t * L ^ 2 := by ring omega · intro q have h := hYcount q rw [transpose_arrayPairs_card, arrayPairs_card L η q.2.2 q.2.1 hη ⟨by positivity, by exact_mod_cast q.2.2.isLt⟩ ⟨by positivity, by exact_mod_cast q.2.1.isLt⟩] at h have h' := hZcount q dsimp [D] omega end DistanceCounts.SkewGadgetRealization end end BodyFile081 -- Source: DistanceCounts/JitterVariance.lean section BodyFile082 /-! Finite-bin covariance bounds for measurable independent integer-valued group jitters. -/ noncomputable section open MeasureTheory ProbabilityTheory open scoped BigOperators namespace DistanceCounts namespace JitterVariance variable {Ω : Type*} [MeasurableSpace Ω] {μ : Measure Ω} /-- The real-valued indicator that an integer random variable occupies a bin. -/ def binIndicator (W : Ω → ℤ) (j : ℤ) (ω : Ω) : ℝ := if W ω = j then 1 else 0 lemma binIndicator_measurable {W : Ω → ℤ} (hW : Measurable W) (j : ℤ) : Measurable (binIndicator W j) := (measurable_of_countable (fun z : ℤ => if z = j then (1 : ℝ) else 0)).comp hW lemma binIndicator_nonneg (W : Ω → ℤ) (j : ℤ) (ω : Ω) : 0 ≤ binIndicator W j ω := by unfold binIndicator split_ifs <;> norm_num lemma binIndicator_le_one (W : Ω → ℤ) (j : ℤ) (ω : Ω) : binIndicator W j ω ≤ 1 := by unfold binIndicator split_ifs <;> norm_num lemma binIndicator_memLp [IsFiniteMeasure μ] {W : Ω → ℤ} (hW : Measurable W) (j : ℤ) : MemLp (binIndicator W j) 2 μ := by exact memLp_of_bounded (Filter.Eventually.of_forall fun ω => ⟨binIndicator_nonneg W j ω, binIndicator_le_one W j ω⟩) (binIndicator_measurable hW j).aestronglyMeasurable 2 lemma binIndicator_integrable [IsFiniteMeasure μ] {W : Ω → ℤ} (hW : Measurable W) (j : ℤ) : Integrable (binIndicator W j) μ := (binIndicator_memLp hW j).integrable (by norm_num) lemma binIndicator_integral {W : Ω → ℤ} (hW : Measurable W) (j : ℤ) : (∫ ω, binIndicator W j ω ∂μ) = μ.real {ω | W ω = j} := by have hs : MeasurableSet {ω | W ω = j} := hW (measurableSet_singleton j) simpa [binIndicator, Set.indicator, Set.mem_setOf_eq] using (integral_indicator_const (μ := μ) (1 : ℝ) hs) lemma joint_integral_eq_probability {U V : Ω → ℤ} (hU : Measurable U) (hV : Measurable V) (j : ℤ) : (∫ ω, binIndicator U j ω * binIndicator V j ω ∂μ) = μ.real {ω | U ω = j ∧ V ω = j} := by have hs : MeasurableSet {ω | U ω = j ∧ V ω = j} := (hU (measurableSet_singleton j)).inter (hV (measurableSet_singleton j)) have heq : (fun ω => binIndicator U j ω * binIndicator V j ω) = Set.indicator {ω | U ω = j ∧ V ω = j} (fun _ => (1 : ℝ)) := by funext ω by_cases hu : U ω = j <;> by_cases hv : V ω = j <;> simp [binIndicator, Set.indicator, hu, hv] rw [heq] simpa using (integral_indicator_const (μ := μ) (1 : ℝ) hs) /-- A pin contributes to at most one of the finitely many bins. -/ lemma sum_binIndicator_le_one (W : Ω → ℤ) (J : Finset ℤ) (ω : Ω) : (∑ j ∈ J, binIndicator W j ω) ≤ 1 := by classical simp only [binIndicator, Finset.sum_ite_eq] split_ifs <;> norm_num /-- The sum of same-bin joint probabilities of any two pins is at most one. -/ lemma sum_joint_le_one [IsProbabilityMeasure μ] {U V : Ω → ℤ} (hU : Measurable U) (hV : Measurable V) (J : Finset ℤ) : (∑ j ∈ J, ∫ ω, binIndicator U j ω * binIndicator V j ω ∂μ) ≤ 1 := by have hint j : Integrable (fun ω => binIndicator U j ω * binIndicator V j ω) μ := (binIndicator_memLp hU j).integrable_mul (binIndicator_memLp hV j) rw [← integral_finsetSum J (fun j _ => hint j)] calc (∫ ω, ∑ j ∈ J, binIndicator U j ω * binIndicator V j ω ∂μ) ≤ ∫ _ : Ω, (1 : ℝ) ∂μ := by apply integral_mono (integrable_finsetSum J (fun j _ => hint j)) (integrable_const 1) intro ω calc (∑ j ∈ J, binIndicator U j ω * binIndicator V j ω) ≤ ∑ j ∈ J, binIndicator U j ω := by apply Finset.sum_le_sum intro j _ exact mul_le_of_le_one_right (binIndicator_nonneg U j ω) (binIndicator_le_one V j ω) _ ≤ 1 := sum_binIndicator_le_one U J ω _ = 1 := by simp lemma covariance_binIndicator_le_joint [IsProbabilityMeasure μ] {U V : Ω → ℤ} (hU : Measurable U) (hV : Measurable V) (j : ℤ) : covariance (binIndicator U j) (binIndicator V j) μ ≤ ∫ ω, binIndicator U j ω * binIndicator V j ω ∂μ := by rw [covariance_eq_sub (binIndicator_memLp hU j) (binIndicator_memLp hV j)] exact sub_le_self _ (mul_nonneg (integral_nonneg (binIndicator_nonneg U j)) (integral_nonneg (binIndicator_nonneg V j))) lemma sum_covariance_le_one [IsProbabilityMeasure μ] {U V : Ω → ℤ} (hU : Measurable U) (hV : Measurable V) (J : Finset ℤ) : (∑ j ∈ J, covariance (binIndicator U j) (binIndicator V j) μ) ≤ 1 := (Finset.sum_le_sum fun j _ => covariance_binIndicator_le_joint hU hV j).trans (sum_joint_le_one hU hV J) /-- In particular, the total variance contributed by a single pin is at most one. -/ lemma sum_pin_variance_le_one [IsProbabilityMeasure μ] {W : Ω → ℤ} (hW : Measurable W) (J : Finset ℤ) : (∑ j ∈ J, variance (binIndicator W j) μ) ≤ 1 := by calc (∑ j ∈ J, variance (binIndicator W j) μ) = ∑ j ∈ J, covariance (binIndicator W j) (binIndicator W j) μ := Finset.sum_congr rfl fun j _ => (covariance_self (binIndicator_measurable hW j).aemeasurable).symm _ ≤ 1 := sum_covariance_le_one hW hW J lemma covariance_binIndicator_nonpos [IsProbabilityMeasure μ] {U V : Ω → ℤ} (hU : Measurable U) (hV : Measurable V) (hdisjoint : ∀ ω, U ω ≠ V ω) (j : ℤ) : covariance (binIndicator U j) (binIndicator V j) μ ≤ 0 := by have hz : (fun ω => binIndicator U j ω * binIndicator V j ω) = 0 := by funext ω have := hdisjoint ω simp only [binIndicator, Pi.zero_apply] split_ifs <;> simp_all have h := covariance_binIndicator_le_joint (μ := μ) hU hV j rw [hz] at h change covariance (binIndicator U j) (binIndicator V j) μ ≤ ∫ _ω, (0 : ℝ) ∂μ at h simpa only [integral_zero] using h lemma covariance_binIndicator_indep [IsProbabilityMeasure μ] {U V : Ω → ℤ} (hU : Measurable U) (hV : Measurable V) (hind : IndepFun U V μ) (j : ℤ) : covariance (binIndicator U j) (binIndicator V j) μ = 0 := by have hind' : IndepFun (binIndicator U j) (binIndicator V j) μ := hind.comp (measurable_of_countable (fun z : ℤ => if z = j then (1 : ℝ) else 0)) (measurable_of_countable (fun z : ℤ => if z = j then (1 : ℝ) else 0)) exact hind'.covariance_eq_zero (binIndicator_memLp hU j) (binIndicator_memLp hV j) /-- Real occupancy of bin `j` by all pins. -/ def occupancy {M : ℕ} (W : Fin M → Ω → ℤ) (j : ℤ) (ω : Ω) : ℝ := ∑ i, binIndicator (W i) j ω lemma occupancy_memLp [IsFiniteMeasure μ] {M : ℕ} {W : Fin M → Ω → ℤ} (hW : ∀ i, Measurable (W i)) (j : ℤ) : MemLp (occupancy W j) 2 μ := memLp_finsetSum Finset.univ (fun i _ => binIndicator_memLp (hW i) j) /-- Abstract finite-bin covariance bound. `near` is only required to contain all same-group pairs which can occupy a bin together; independence is genuine independence of the bin-valued random variables for different groups. -/ theorem finite_bin_variance_bound [IsProbabilityMeasure μ] {M : ℕ} {G : Type*} [DecidableEq G] (g : Fin M → G) (W : Fin M → Ω → ℤ) (hW : ∀ i, Measurable (W i)) (near : Fin M → Fin M → Prop) [DecidableRel near] (hind : ∀ i k, g i ≠ g k → IndepFun (W i) (W k) μ) (hfar : ∀ i k, g i = g k → ¬ near i k → ∀ ω, W i ω ≠ W k ω) (J : Finset ℤ) : (∑ j ∈ J, variance (occupancy W j) μ) ≤ (M : ℝ) + ((Finset.univ.filter (fun p : Fin M × Fin M => p.1 ≠ p.2 ∧ g p.1 = g p.2 ∧ near p.1 p.2)).card : ℝ) := by classical have hpair (i k : Fin M) : (∑ j ∈ J, covariance (binIndicator (W i) j) (binIndicator (W k) j) μ) ≤ (if i = k then (1 : ℝ) else 0) + (if i ≠ k ∧ g i = g k ∧ near i k then (1 : ℝ) else 0) := by by_cases hik : i = k · simpa [hik] using sum_covariance_le_one (μ := μ) (hW i) (hW k) J by_cases hg : g i = g k · by_cases hn : near i k · simpa [hik, hg, hn] using sum_covariance_le_one (μ := μ) (hW i) (hW k) J · simp only [hik, hg, hn, not_false_eq_true, true_and, and_false, if_false, zero_add] exact Finset.sum_nonpos fun j _ => covariance_binIndicator_nonpos (hW i) (hW k) (hfar i k hg hn) j · simp only [hik, hg, not_false_eq_true, true_and, false_and, and_false, if_false, zero_add] exact le_of_eq (Finset.sum_eq_zero fun j _ => covariance_binIndicator_indep (hW i) (hW k) (hind i k hg) j) have hexpand (j : ℤ) : variance (occupancy W j) μ = ∑ i, ∑ k, covariance (binIndicator (W i) j) (binIndicator (W k) j) μ := by rw [← covariance_self (occupancy_memLp hW j).aestronglyMeasurable.aemeasurable] exact covariance_fun_sum_fun_sum (fun i => binIndicator_memLp (hW i) j) (fun i => binIndicator_memLp (hW i) j) calc (∑ j ∈ J, variance (occupancy W j) μ) = ∑ i, ∑ k, ∑ j ∈ J, covariance (binIndicator (W i) j) (binIndicator (W k) j) μ := by simp_rw [hexpand] rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i _ rw [Finset.sum_comm] _ ≤ ∑ i : Fin M, ∑ k : Fin M, ((if i = k then (1 : ℝ) else 0) + (if i ≠ k ∧ g i = g k ∧ near i k then (1 : ℝ) else 0)) := Finset.sum_le_sum fun i _ => Finset.sum_le_sum fun k _ => hpair i k _ = (M : ℝ) + ((Finset.univ.filter (fun p : Fin M × Fin M => p.1 ≠ p.2 ∧ g p.1 = g p.2 ∧ near p.1 p.2)).card : ℝ) := by simp only [Finset.sum_add_distrib] congr 1 · simp · rw [← Fintype.sum_prod_type'] simp /-- Equal Euclidean-division bins force integer separation strictly below the width. -/ lemma abs_sub_lt_of_ediv_eq {a b B : ℤ} (hB : 0 < B) (h : a / B = b / B) : |a - b| < B := by have ha := Int.emod_add_mul_ediv a B have hb := Int.emod_add_mul_ediv b B have ha0 := Int.emod_nonneg a hB.ne' have hb0 := Int.emod_nonneg b hB.ne' have haB := Int.emod_lt_of_pos a hB have hbB := Int.emod_lt_of_pos b hB rw [h] at ha rw [abs_lt] constructor <;> omega /-- The jittered level `Z i - q (g i)` is assigned its integer bin. -/ def jitterBin {M : ℕ} {G : Type*} (Z : Fin M → ℤ) (g : Fin M → G) (q : G → Ω → ℤ) (B : ℤ) (i : Fin M) (ω : Ω) : ℤ := (Z i - q (g i) ω) / B /-- The exact finite form of Proof.md (26), with ordered distinct near pairs. No distributional assumption beyond measurable independent group jitters is needed. -/ theorem jitter_variance_bound [IsProbabilityMeasure μ] {M : ℕ} {G : Type*} [Fintype G] [DecidableEq G] (Z : Fin M → ℤ) (g : Fin M → G) (q : G → Ω → ℤ) (hq : ∀ a, Measurable (q a)) (hind : iIndepFun q μ) (B : ℤ) (hB : 0 < B) (J : Finset ℤ) : (∑ j ∈ J, variance (occupancy (jitterBin Z g q B) j) μ) ≤ (M : ℝ) + ((Finset.univ.filter (fun p : Fin M × Fin M => p.1 ≠ p.2 ∧ g p.1 = g p.2 ∧ |Z p.1 - Z p.2| < B)).card : ℝ) := by apply finite_bin_variance_bound g (jitterBin Z g q B) (fun i => (measurable_of_countable (fun z : ℤ => (Z i - z) / B)).comp (hq (g i))) (fun i k => |Z i - Z k| < B) · intro i k hik exact (hind.indepFun hik).comp (measurable_of_countable (fun z : ℤ => (Z i - z) / B)) (measurable_of_countable (fun z : ℤ => (Z k - z) / B)) · intro i k hg hn ω heq apply hn have h := abs_sub_lt_of_ediv_eq hB heq simpa only [hg, sub_sub_sub_cancel_right] using h /-- Unordered pairs are represented canonically by increasing pin indices. -/ theorem ordered_near_count_eq_twice_unordered {M : ℕ} {G : Type*} [DecidableEq G] (Z : Fin M → ℤ) (g : Fin M → G) (B : ℤ) : (Finset.univ.filter (fun p : Fin M × Fin M => p.1 ≠ p.2 ∧ g p.1 = g p.2 ∧ |Z p.1 - Z p.2| < B)).card = 2 * (Finset.univ.filter (fun p : Fin M × Fin M => p.1 < p.2 ∧ g p.1 = g p.2 ∧ |Z p.1 - Z p.2| < B)).card := by classical let u := Finset.univ.filter (fun p : Fin M × Fin M => p.1 < p.2 ∧ g p.1 = g p.2 ∧ |Z p.1 - Z p.2| < B) let v := Finset.univ.filter (fun p : Fin M × Fin M => p.2 < p.1 ∧ g p.1 = g p.2 ∧ |Z p.1 - Z p.2| < B) have hdisj : Disjoint u v := by simp only [u, v, Finset.disjoint_left, Finset.mem_filter, Finset.mem_univ, true_and] intro p hp hq exact (lt_asymm hp.1 hq.1) have hunion : u ∪ v = Finset.univ.filter (fun p : Fin M × Fin M => p.1 ≠ p.2 ∧ g p.1 = g p.2 ∧ |Z p.1 - Z p.2| < B) := by ext p simp only [u, v, Finset.mem_union, Finset.mem_filter, Finset.mem_univ, true_and] constructor · rintro (h | h) · exact ⟨ne_of_lt h.1, h.2⟩ · exact ⟨ne_of_gt h.1, h.2⟩ · intro h rcases lt_or_gt_of_ne h.1 with hlt | hgt · exact Or.inl ⟨hlt, h.2⟩ · exact Or.inr ⟨hgt, h.2⟩ have hcard : u.card = v.card := by apply Finset.card_equiv (Equiv.prodComm (Fin M) (Fin M)) intro p simp only [u, v, Finset.mem_filter, Finset.mem_univ, true_and, Equiv.prodComm_apply] dsimp only [Prod.swap] rw [abs_sub_comm (Z p.2) (Z p.1)] exact and_congr_right fun _ => and_congr_left fun _ => eq_comm rw [← hunion, Finset.card_union_of_disjoint hdisj, ← hcard] change u.card + u.card = 2 * u.card omega /-- Equation (26) with the document's unordered-pair convention. -/ theorem jitter_variance_bound_unordered [IsProbabilityMeasure μ] {M : ℕ} {G : Type*} [Fintype G] [DecidableEq G] (Z : Fin M → ℤ) (g : Fin M → G) (q : G → Ω → ℤ) (hq : ∀ a, Measurable (q a)) (hind : iIndepFun q μ) (B : ℤ) (hB : 0 < B) (J : Finset ℤ) : (∑ j ∈ J, variance (occupancy (jitterBin Z g q B) j) μ) ≤ (M : ℝ) + 2 * ((Finset.univ.filter (fun p : Fin M × Fin M => p.1 < p.2 ∧ g p.1 = g p.2 ∧ |Z p.1 - Z p.2| < B)).card : ℝ) := by have h := jitter_variance_bound Z g q hq hind B hB J rw [ordered_near_count_eq_twice_unordered Z g B] at h simpa only [Nat.cast_mul, Nat.cast_ofNat] using h end JitterVariance end DistanceCounts end end BodyFile082 -- Source: DistanceCounts/RowPairAverage.lean section BodyFile083 /-! Conditional same-row estimates for actual measurable integer levels. The good set and the levels can be dependent. No construction of either is asserted here. -/ noncomputable section open Set MeasureTheory Filter open scoped BigOperators namespace DistanceCounts.RowPairAverage open ProjectionDensity ParameterKernel abbrev Pin (K L : ℕ) := Fin K × (Fin L × Fin L) def group {K L : ℕ} (i : Pin K L) : Fin K × Fin L := (i.1, i.2.2) /-- An honest real indicator of an open affine strip. -/ def stripIndicator (R : ℝ) : ℝ → ℝ := (Ioo (-R) R).indicator (fun _ => 1) lemma stripIndicator_measurable (R : ℝ) : Measurable (stripIndicator R) := measurable_const.indicator measurableSet_Ioo lemma stripIndicator_bounds (R t : ℝ) : 0 ≤ stripIndicator R t ∧ stripIndicator R t ≤ 1 := by simp only [stripIndicator, Set.indicator] split_ifs <;> norm_num lemma stripIndicator_integrable (R : ℝ) : Integrable (stripIndicator R) := (integrableOn_const (by simp : volume (Ioo (-R) R) ≠ ⊤)).integrable_indicator measurableSet_Ioo lemma integral_stripIndicator {R : ℝ} (hR : 0 ≤ R) : (∫ t, stripIndicator R t) = 2 * R := by have hwidth : R - -R = 2 * R := by ring have hwidth_nonneg : 0 ≤ 2 * R := mul_nonneg (by norm_num) hR simp [stripIndicator, integral_indicator_const, Real.volume_real_Ioo, hwidth, max_eq_left hwidth_nonneg, smul_eq_mul] /-- The normalized Lebesgue probability bound, for either sign of the slope. The second parameter is integrated out, not treated as an independent good event. -/ theorem integral_affine_strip_le {δ R u : ℝ} (hδ : 0 < δ) (hR : 0 ≤ R) (hu : u ≠ 0) (c : ℝ) : (∫ a, stripIndicator R (c + u * a.1) ∂parameterMeasure δ) ≤ 2 * R / (δ * |u|) := by letI := uniformIntervalMeasure_probability hδ letI := uniformIntervalMeasure_probability (by norm_num : (0 : ℝ) < 1) letI := parameterMeasure_probability hδ have hm : Measurable (fun a : ℝ × ℝ => stripIndicator R (c + u * a.1)) := (stripIndicator_measurable R).comp (by fun_prop) have hi : Integrable (fun a : ℝ × ℝ => stripIndicator R (c + u * a.1)) (parameterMeasure δ) := Integrable.of_bound hm.aestronglyMeasurable 1 (Eventually.of_forall fun a => by rw [Real.norm_eq_abs, abs_of_nonneg (stripIndicator_bounds _ _).1] exact (stripIndicator_bounds _ _).2) rw [parameterMeasure, integral_prod _ hi] simp only [integral_const, Measure.real, measure_univ, ENNReal.toReal_one, one_smul] rw [integral_uniform_affine hδ hu c] let w := δ * |u| let d := c + min (δ * u) 0 have hw : 0 < w := mul_pos hδ (abs_pos.mpr hu) have ht : Integrable (fun t => stripIndicator R (d + t)) := (stripIndicator_integrable R).comp_add_left d have hmt : Measurable (fun t => stripIndicator R (d + t)) := (stripIndicator_measurable R).comp (by fun_prop) have hprod : Integrable (fun t => box w t * stripIndicator R (d + t)) := (integrable_box w).mul_bdd hmt.aestronglyMeasurable (Eventually.of_forall fun t => by rw [Real.norm_eq_abs, abs_of_nonneg (stripIndicator_bounds _ _).1] exact (stripIndicator_bounds _ _).2) calc (∫ t, box w t * stripIndicator R (d + t)) ≤ ∫ t, (1 / w) * stripIndicator R (d + t) := integral_mono hprod (ht.const_mul _) fun t => mul_le_mul_of_nonneg_right (box_le hw t) (stripIndicator_bounds _ _).1 _ = 2 * R / (δ * |u|) := by rw [integral_const_mul, integral_add_left_eq_self, integral_stripIndicator hR] dsimp [w] ring /-- In measure notation this is the genuine parameter probability of the strip. -/ theorem affine_strip_probability_le {δ R u : ℝ} (hδ : 0 < δ) (hR : 0 ≤ R) (hu : u ≠ 0) (c : ℝ) : (parameterMeasure δ).real {a | |c + u * a.1| < R} ≤ 2 * R / (δ * |u|) := by have hs : MeasurableSet {a : ℝ × ℝ | |c + u * a.1| < R} := measurableSet_lt (by fun_prop) measurable_const have he : (fun a : ℝ × ℝ => stripIndicator R (c + u * a.1)) = {a : ℝ × ℝ | |c + u * a.1| < R}.indicator (fun _ => (1 : ℝ)) := by funext a simp [stripIndicator, Set.indicator, abs_lt] have h := integral_affine_strip_le hδ hR hu c rw [he, integral_indicator_const _ hs] at h simpa using h /-- Each horizontal displacement is counted at most once for a fixed pin. -/ lemma sum_inverse_row_difference_le (L : ℕ) (x : Fin L) : (∑ z : Fin L, |(x.val : ℝ) - z.val|⁻¹) ≤ 2 * (1 + Real.log L) := by classical let f : Fin L → ℤ := fun z => (z.val : ℤ) - (x.val : ℤ) have hf : Function.Injective f := by intro z w h apply Fin.ext have hsub : (z.val : ℤ) - (x.val : ℤ) = (w.val : ℤ) - (x.val : ℤ) := h have hval : (z.val : ℤ) = (w.val : ℤ) := by omega exact_mod_cast hval have hsub : Finset.univ.image f ⊆ Finset.Icc (-(L : ℤ)) L := by intro d hd obtain ⟨z, _, rfl⟩ := Finset.mem_image.mp hd have hx := x.isLt have hz := z.isLt simp only [Finset.mem_Icc, f] constructor <;> omega have heven : (fun d : ℤ => |(d : ℝ)|⁻¹).Even := by intro d simp have habs (n : ℕ) : |(n : ℝ) + 1| = (n : ℝ) + 1 := abs_of_nonneg (by positivity) calc (∑ z : Fin L, |(x.val : ℝ) - z.val|⁻¹) = ∑ d ∈ Finset.univ.image f, |(d : ℝ)|⁻¹ := by rw [Finset.sum_image (fun _ _ _ _ h => hf h)] apply Finset.sum_congr rfl intro z _ simp [f, abs_sub_comm] _ ≤ ∑ d ∈ Finset.Icc (-(L : ℤ)) L, |(d : ℝ)|⁻¹ := Finset.sum_le_sum_of_subset_of_nonneg hsub (fun _ _ _ => by positivity) _ = 2 * (harmonic L : ℝ) := by rw [Finset.sum_Icc_of_even_eq_range heven, Finset.sum_range_succ'] simp [harmonic, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast, nsmul_eq_mul, habs] _ ≤ 2 * (1 + Real.log L) := mul_le_mul_of_nonneg_left (harmonic_le_one_add_log L) (by norm_num) /-- The coordinates are `(block,row,x,x')`; the diagonal is explicitly excluded. -/ def nearPairs {K L : ℕ} (Z : Pin K L → (ℝ × ℝ) → ℤ) (B : ℤ) (a : ℝ × ℝ) : Finset (Fin K × (Fin L × (Fin L × Fin L))) := by classical exact Finset.univ.filter fun p => p.2.2.1 ≠ p.2.2.2 ∧ |Z (p.1, p.2.2.1, p.2.1) a - Z (p.1, p.2.2.2, p.2.1) a| < B /-- Actual ordered distinct same-row count, as a real-valued finite cardinality. -/ def count {K L : ℕ} (Z : Pin K L → (ℝ × ℝ) → ℤ) (B : ℤ) (a : ℝ × ℝ) : ℝ := (nearPairs Z B a).card private def pairIndicator {K L : ℕ} (Z : Pin K L → (ℝ × ℝ) → ℤ) (B : ℤ) (good : Set (ℝ × ℝ)) (b : Fin K) (y x z : Fin L) : (ℝ × ℝ) → ℝ := good.indicator (fun a => if x ≠ z ∧ |Z (b, x, y) a - Z (b, z, y) a| < B then 1 else 0) private lemma pairIndicator_bounds {K L : ℕ} (Z : Pin K L → (ℝ × ℝ) → ℤ) (B : ℤ) (good : Set (ℝ × ℝ)) (b : Fin K) (y x z : Fin L) (a : ℝ × ℝ) : 0 ≤ pairIndicator Z B good b y x z a ∧ pairIndicator Z B good b y x z a ≤ 1 := by classical simp only [pairIndicator, Set.indicator] split_ifs <;> norm_num private lemma pairIndicator_measurable {K L : ℕ} {Z : Pin K L → (ℝ × ℝ) → ℤ} (hZ : ∀ i, Measurable (Z i)) (B : ℤ) {good : Set (ℝ × ℝ)} (hg : MeasurableSet good) (b : Fin K) (y x z : Fin L) : Measurable (pairIndicator Z B good b y x z) := by classical exact ((measurable_of_countable (fun t : ℤ => if x ≠ z ∧ |t| < B then (1 : ℝ) else 0)).comp ((hZ (b, x, y)).sub (hZ (b, z, y)))).indicator hg private lemma pairIndicator_integrable {K L : ℕ} {Z : Pin K L → (ℝ × ℝ) → ℤ} {δ : ℝ} (hδ : 0 < δ) (hZ : ∀ i, Measurable (Z i)) (B : ℤ) {good : Set (ℝ × ℝ)} (hg : MeasurableSet good) (b : Fin K) (y x z : Fin L) : Integrable (pairIndicator Z B good b y x z) (parameterMeasure δ) := by letI := parameterMeasure_probability hδ exact Integrable.of_bound (pairIndicator_measurable hZ B hg b y x z).aestronglyMeasurable 1 (Eventually.of_forall fun a => by rw [Real.norm_eq_abs, abs_of_nonneg (pairIndicator_bounds _ _ _ _ _ _ _ _).1] exact (pairIndicator_bounds _ _ _ _ _ _ _ _).2) lemma good_count_eq_sum {K L : ℕ} (Z : Pin K L → (ℝ × ℝ) → ℤ) (B : ℤ) (good : Set (ℝ × ℝ)) (a : ℝ × ℝ) : good.indicator (count Z B) a = ∑ b, ∑ y, ∑ x, ∑ z, pairIndicator Z B good b y x z a := by classical by_cases ha : a ∈ good · simp only [Set.indicator_of_mem ha, pairIndicator, count, nearPairs, Finset.card_filter, Nat.cast_sum, Nat.cast_ite, Nat.cast_one, Nat.cast_zero, Fintype.sum_prod_type] · simp [Set.indicator_of_notMem ha, pairIndicator, ha] lemma measurable_count {K L : ℕ} {Z : Pin K L → (ℝ × ℝ) → ℤ} (hZ : ∀ i, Measurable (Z i)) (B : ℤ) : Measurable (count Z B) := by have he : count Z B = fun a => ∑ b, ∑ y, ∑ x, ∑ z, pairIndicator Z B Set.univ b y x z a := by funext a simpa using good_count_eq_sum Z B Set.univ a rw [he] exact Finset.measurable_sum _ fun b _ => Finset.measurable_sum _ fun y _ => Finset.measurable_sum _ fun x _ => Finset.measurable_sum _ fun z _ => pairIndicator_measurable hZ B MeasurableSet.univ b y x z lemma integrable_good_count {K L : ℕ} {Z : Pin K L → (ℝ × ℝ) → ℤ} {δ : ℝ} (hδ : 0 < δ) (hZ : ∀ i, Measurable (Z i)) (B : ℤ) {good : Set (ℝ × ℝ)} (hg : MeasurableSet good) : Integrable (good.indicator (count Z B)) (parameterMeasure δ) := by simp_rw [show good.indicator (count Z B) = fun a => ∑ b, ∑ y, ∑ x, ∑ z, pairIndicator Z B good b y x z a from funext (good_count_eq_sum Z B good)] exact integrable_finsetSum _ fun b _ => integrable_finsetSum _ fun y _ => integrable_finsetSum _ fun x _ => integrable_finsetSum _ fun z _ => pairIndicator_integrable hδ hZ B hg b y x z lemma integrable_count {K L : ℕ} {Z : Pin K L → (ℝ × ℝ) → ℤ} {δ : ℝ} (hδ : 0 < δ) (hZ : ∀ i, Measurable (Z i)) (B : ℤ) : Integrable (count Z B) (parameterMeasure δ) := by simpa using integrable_good_count hδ hZ B MeasurableSet.univ /-- The sole structural assumption: a bounded error in differences on a block-row. The deterministic errors may be arbitrarily large; only their cancellation matters. -/ def RowDifference {K L : ℕ} (Z : Pin K L → (ℝ × ℝ) → ℤ) (e : Pin K L → ℝ) (good : Set (ℝ × ℝ)) (δ E : ℝ) : Prop := ∀ a ∈ good, ∀ i j, group i = group j → |((Z i a - Z j a : ℤ) : ℝ) - ((1 - δ + a.1) * L * ((i.2.1.val : ℝ) - j.2.1.val) + (e i - e j))| ≤ 2 * E /-- Actual near levels on the good event imply a real affine strip. -/ theorem near_implies_affine_strip {K L : ℕ} {Z : Pin K L → (ℝ × ℝ) → ℤ} {e : Pin K L → ℝ} {good : Set (ℝ × ℝ)} {δ E : ℝ} {B : ℤ} (hrow : RowDifference Z e good δ E) {a : ℝ × ℝ} (ha : a ∈ good) {i j : Pin K L} (hg : group i = group j) (hn : |Z i a - Z j a| < B) : |(1 - δ + a.1) * L * ((i.2.1.val : ℝ) - j.2.1.val) + (e i - e j)| < (B : ℝ) + 2 * E := by have h := hrow a ha i j hg have hn' : |((Z i a - Z j a : ℤ) : ℝ)| < (B : ℝ) := by exact_mod_cast hn have ht := abs_add_le ((Z i a - Z j a : ℤ) : ℝ) (((1 - δ + a.1) * L * ((i.2.1.val : ℝ) - j.2.1.val) + (e i - e j)) - ((Z i a - Z j a : ℤ) : ℝ)) have he : ((Z i a - Z j a : ℤ) : ℝ) + (((1 - δ + a.1) * L * ((i.2.1.val : ℝ) - j.2.1.val) + (e i - e j)) - ((Z i a - Z j a : ℤ) : ℝ)) = (1 - δ + a.1) * L * ((i.2.1.val : ℝ) - j.2.1.val) + (e i - e j) := by ring rw [he, abs_sub_comm] at ht linarith private theorem integral_pairIndicator_le {K L : ℕ} {Z : Pin K L → (ℝ × ℝ) → ℤ} {e : Pin K L → ℝ} {good : Set (ℝ × ℝ)} {δ E : ℝ} {B : ℤ} (hδ : 0 < δ) (hL : 0 < L) (hE : 0 ≤ E) (hB : 0 < B) (hZ : ∀ i, Measurable (Z i)) (hg : MeasurableSet good) (hrow : RowDifference Z e good δ E) (b : Fin K) (y x z : Fin L) : (∫ a, pairIndicator Z B good b y x z a ∂parameterMeasure δ) ≤ (2 * ((B : ℝ) + 2 * E) / (δ * L)) * |(x.val : ℝ) - z.val|⁻¹ := by classical by_cases hxz : x = z · subst z simp [pairIndicator, Set.indicator] have hd : (x.val : ℝ) - z.val ≠ 0 := by intro h apply hxz apply Fin.ext exact_mod_cast (sub_eq_zero.mp h) have hL' : 0 < (L : ℝ) := by exact_mod_cast hL have hB' : 0 < (B : ℝ) := by exact_mod_cast hB let R : ℝ := (B : ℝ) + 2 * E let u : ℝ := L * ((x.val : ℝ) - z.val) let c : ℝ := (1 - δ) * L * ((x.val : ℝ) - z.val) + (e (b, x, y) - e (b, z, y)) have hu : u ≠ 0 := mul_ne_zero hL'.ne' hd have hR : 0 ≤ R := by dsimp [R]; positivity have he (a : ℝ × ℝ) : c + u * a.1 = (1 - δ + a.1) * L * ((x.val : ℝ) - z.val) + (e (b, x, y) - e (b, z, y)) := by dsimp [c, u]; ring have hpoint (a : ℝ × ℝ) : pairIndicator Z B good b y x z a ≤ stripIndicator R (c + u * a.1) := by by_cases ha : a ∈ good · by_cases hn : |Z (b, x, y) a - Z (b, z, y) a| < B · have hs := near_implies_affine_strip hrow ha (i := (b, x, y)) (j := (b, z, y)) rfl hn rw [← he a] at hs simp [pairIndicator, ha, hxz, hn, stripIndicator, Set.indicator, show -R < c + u * a.1 ∧ c + u * a.1 < R from abs_lt.mp hs] · simpa [pairIndicator, ha, hn] using (stripIndicator_bounds R (c + u * a.1)).1 · simpa [pairIndicator, ha] using (stripIndicator_bounds R (c + u * a.1)).1 letI := parameterMeasure_probability hδ have hi : Integrable (fun a : ℝ × ℝ => stripIndicator R (c + u * a.1)) (parameterMeasure δ) := Integrable.of_bound ((stripIndicator_measurable R).comp (by fun_prop)).aestronglyMeasurable 1 (Eventually.of_forall fun a => by rw [Real.norm_eq_abs, abs_of_nonneg (stripIndicator_bounds _ _).1] exact (stripIndicator_bounds _ _).2) calc _ ≤ ∫ a, stripIndicator R (c + u * a.1) ∂parameterMeasure δ := integral_mono (pairIndicator_integrable hδ hZ B hg b y x z) hi hpoint _ ≤ 2 * R / (δ * |u|) := integral_affine_strip_le hδ hR hu c _ = _ := by dsimp [R, u] rw [abs_mul, abs_of_pos hL'] simp only [div_eq_mul_inv, mul_inv] ring /-- A single distinct horizontal pair has small genuine normalized parameter probability even when its levels and the good event depend on both parameters. -/ theorem near_pair_probability_le {K L : ℕ} {Z : Pin K L → (ℝ × ℝ) → ℤ} {e : Pin K L → ℝ} {good : Set (ℝ × ℝ)} {δ E : ℝ} {B : ℤ} (hδ : 0 < δ) (hL : 0 < L) (hE : 0 ≤ E) (hB : 0 < B) (hZ : ∀ i, Measurable (Z i)) (hg : MeasurableSet good) (hrow : RowDifference Z e good δ E) (b : Fin K) (y x z : Fin L) (hxz : x ≠ z) : (parameterMeasure δ).real {a | a ∈ good ∧ |Z (b, x, y) a - Z (b, z, y) a| < B} ≤ 2 * ((B : ℝ) + 2 * E) / (δ * L * |(x.val : ℝ) - z.val|) := by have hn : MeasurableSet {a | |Z (b, x, y) a - Z (b, z, y) a| < B} := measurableSet_lt ((measurable_of_countable (fun t : ℤ => |t|)).comp ((hZ (b, x, y)).sub (hZ (b, z, y)))) measurable_const have hs : MeasurableSet {a | a ∈ good ∧ |Z (b, x, y) a - Z (b, z, y) a| < B} := hg.inter hn have he : pairIndicator Z B good b y x z = {a | a ∈ good ∧ |Z (b, x, y) a - Z (b, z, y) a| < B}.indicator (fun _ => (1 : ℝ)) := by funext a by_cases ha : a ∈ good <;> simp [pairIndicator, Set.indicator, ha, hxz] have h := integral_pairIndicator_le hδ hL hE hB hZ hg hrow b y x z rw [he, integral_indicator_const _ hs] at h simpa only [smul_eq_mul, mul_one, div_eq_mul_inv, mul_inv, mul_assoc] using h /-- Actual averaged ordered same-row count, with the absolute constant `4`. All parameter restrictions occur inside the integrand. -/ theorem integral_good_count_le {K L : ℕ} {Z : Pin K L → (ℝ × ℝ) → ℤ} {e : Pin K L → ℝ} {good : Set (ℝ × ℝ)} {δ E : ℝ} {B : ℤ} (hδ : 0 < δ) (hL : 0 < L) (hE : 0 ≤ E) (hB : 0 < B) (hZ : ∀ i, Measurable (Z i)) (hg : MeasurableSet good) (hrow : RowDifference Z e good δ E) : (∫ a, good.indicator (count Z B) a ∂parameterMeasure δ) ≤ 4 / δ * K * L * ((B : ℝ) + 2 * E) * (1 + Real.log L) := by have hi := pairIndicator_integrable hδ hZ B hg have hL' : 0 < (L : ℝ) := by exact_mod_cast hL have hB' : 0 < (B : ℝ) := by exact_mod_cast hB let A : ℝ := 2 * ((B : ℝ) + 2 * E) / (δ * L) have hA : 0 ≤ A := by dsimp [A]; positivity simp_rw [good_count_eq_sum] rw [integral_finsetSum _ (fun b _ => integrable_finsetSum _ fun y _ => integrable_finsetSum _ fun x _ => integrable_finsetSum _ fun z _ => hi b y x z)] simp_rw [integral_finsetSum _ (fun y _ => integrable_finsetSum _ fun x _ => integrable_finsetSum _ fun z _ => hi _ y x z)] simp_rw [integral_finsetSum _ (fun x _ => integrable_finsetSum _ fun z _ => hi _ _ x z)] simp_rw [integral_finsetSum _ (fun z _ => hi _ _ _ z)] calc _ ≤ ∑ b : Fin K, ∑ y : Fin L, ∑ x : Fin L, ∑ z : Fin L, A * |(x.val : ℝ) - z.val|⁻¹ := Finset.sum_le_sum fun b _ => Finset.sum_le_sum fun y _ => Finset.sum_le_sum fun x _ => Finset.sum_le_sum fun z _ => integral_pairIndicator_le hδ hL hE hB hZ hg hrow b y x z _ ≤ ∑ _b : Fin K, ∑ _y : Fin L, ∑ _x : Fin L, A * (2 * (1 + Real.log L)) := by apply Finset.sum_le_sum intro b _ apply Finset.sum_le_sum intro y _ apply Finset.sum_le_sum intro x _ rw [← Finset.mul_sum] exact mul_le_mul_of_nonneg_left (sum_inverse_row_difference_le L x) hA _ = 4 / δ * K * L * ((B : ℝ) + 2 * E) * (1 + Real.log L) := by simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] dsimp [A] field_simp <;> ring /-- Injective reindexing cannot increase the ordered count appearing in `JitterVariance.jitter_variance_bound`; selected pins do not remove original pins. -/ theorem reindexed_ordered_count_le {K L M : ℕ} (ι : Fin M → Pin K L) (hι : Function.Injective ι) (Z : Pin K L → (ℝ × ℝ) → ℤ) (B : ℤ) (a : ℝ × ℝ) : (Finset.univ.filter (fun p : Fin M × Fin M => p.1 ≠ p.2 ∧ group (ι p.1) = group (ι p.2) ∧ |Z (ι p.1) a - Z (ι p.2) a| < B)).card ≤ (nearPairs Z B a).card := by classical let f : Fin M × Fin M → Fin K × (Fin L × (Fin L × Fin L)) := fun p => ((ι p.1).1, (ι p.1).2.2, (ι p.1).2.1, (ι p.2).2.1) have recover (p : Fin M × Fin M) (hg : group (ι p.1) = group (ι p.2)) : (ι p.1, ι p.2) = (((f p).1, (f p).2.2.1, (f p).2.1), ((f p).1, (f p).2.2.2, (f p).2.1)) := by have hb := congrArg Prod.fst hg have hy := congrArg Prod.snd hg dsimp [group] at hb hy apply Prod.ext · rfl · apply Prod.ext · exact hb.symm · exact Prod.ext rfl hy.symm apply Finset.card_le_card_of_injOn f · intro p hp obtain ⟨hne, hg, hn⟩ := (Finset.mem_filter.mp hp).2 have hr := recover p hg have hr₁ : ι p.1 = ((f p).1, (f p).2.2.1, (f p).2.1) := congrArg Prod.fst hr have hr₂ : ι p.2 = ((f p).1, (f p).2.2.2, (f p).2.1) := congrArg Prod.snd hr have hne' : (f p).2.2.1 ≠ (f p).2.2.2 := by intro hx apply hne apply hι rw [hr₁, hr₂, hx] have hn' := hn rw [hr₁, hr₂] at hn' exact Finset.mem_filter.mpr ⟨Finset.mem_univ _, hne', hn'⟩ · intro p hp q hq hpq have hp' := recover p (Finset.mem_filter.mp hp).2.2.1 have hq' := recover q (Finset.mem_filter.mp hq).2.2.1 have hr : (ι p.1, ι p.2) = (ι q.1, ι q.2) := by rw [hp', hq', hpq] exact Prod.ext (hι (congrArg Prod.fst hr)) (hι (congrArg Prod.snd hr)) /-- Twice the canonically unordered count used in the jitter variance theorem is bounded by the full original ordered row count, for every parameter. -/ theorem twice_reindexed_unordered_count_le {K L M : ℕ} (ι : Fin M → Pin K L) (hι : Function.Injective ι) (Z : Pin K L → (ℝ × ℝ) → ℤ) (B : ℤ) (a : ℝ × ℝ) : 2 * ((Finset.univ.filter (fun p : Fin M × Fin M => p.1 < p.2 ∧ group (ι p.1) = group (ι p.2) ∧ |Z (ι p.1) a - Z (ι p.2) a| < B)).card : ℝ) ≤ count Z B a := by have h := reindexed_ordered_count_le ι hι Z B a rw [JitterVariance.ordered_near_count_eq_twice_unordered (fun i => Z (ι i) a) (fun i => group (ι i)) B] at h unfold count exact_mod_cast h end DistanceCounts.RowPairAverage end end BodyFile083 -- Source: DistanceCounts/SkewScores.lean section BodyFile084 /-! Integer levels defined before any geometric choices, and their exact realization. -/ noncomputable section open Set MeasureTheory open scoped BigOperators namespace DistanceCounts.SkewScores open SkewParameters /-- The integer floor formula for one actual skew gadget. -/ def floorCount (L : ℕ) (γ : ℝ) (x y : ℤ) : ℤ := 4 * (L : ℤ) ^ 2 + L - L * x + SkewGadget.floorSum L γ y /-- The common real constant is not required to be integral. -/ def commonConst (δ : ℝ) (L : ℕ) (a : ℝ × ℝ) : ℝ := -8 * (L : ℝ) ^ 2 - L + (gamma a + eta δ a) * L * ((L : ℝ) - 1) /-- Defined globally from finitely many integer floors, independently of any extension. -/ def score {B : Type*} {L : ℕ} (δ : ℝ) (Z0 : B × GridPairs.Grid L → ℤ) (i : B × GridPairs.Grid L) (a : ℝ × ℝ) : ℤ := Z0 i - floorCount L (gamma a) i.2.1 i.2.2 - floorCount L (eta δ a) i.2.2 i.2.1 - ⌊commonConst δ L a⌋ /-- The entire parameter-dependent perturbation, including common-constant rounding. -/ def floorError (δ : ℝ) (L : ℕ) (q : GridPairs.Grid L) (a : ℝ × ℝ) : ℝ := -SkewGadget.centeredError L (gamma a) q.2 - SkewGadget.centeredError L (eta δ a) q.1 + Int.fract (commonConst δ L a) theorem measurable_floorCount (L : ℕ) (x y : ℤ) : Measurable (fun γ : ℝ => floorCount L γ x y) := by unfold floorCount SkewGadget.floorSum apply measurable_const.add exact Finset.measurable_sum _ fun r _ => (show Measurable (fun γ : ℝ => 2 * γ * ((y : ℝ) - (r : ℝ))) by fun_prop).floor theorem measurable_commonConst (δ : ℝ) (L : ℕ) : Measurable (commonConst δ L) := by unfold commonConst gamma eta fun_prop theorem measurable_score {B : Type*} {L : ℕ} (δ : ℝ) (Z0 : B × GridPairs.Grid L → ℤ) (i : B × GridPairs.Grid L) : Measurable (score δ Z0 i) := by unfold score exact ((measurable_const.sub ((measurable_floorCount L _ _).comp (show Measurable gamma by unfold gamma; fun_prop))).sub ((measurable_floorCount L _ _).comp (show Measurable (eta δ) by unfold eta; fun_prop))).sub (measurable_commonConst δ L).floor /-- Exact affine decomposition, valid even outside the good event. -/ theorem score_affine {B : Type*} {L : ℕ} (δ : ℝ) (Z0 : B × GridPairs.Grid L → ℤ) (i : B × GridPairs.Grid L) (a : ℝ × ℝ) : (score δ Z0 i a : ℝ) = (Z0 i : ℝ) + alpha δ a * L * i.2.1.val + beta a * L * i.2.2.val + floorError δ L i.2 a := by have hg := SkewGadget.floorSum_decomposition L (gamma a) (i.2.2 : ℤ) have he := SkewGadget.floorSum_decomposition L (eta δ a) (i.2.1 : ℤ) have hf := Int.floor_add_fract (commonConst δ L a) unfold score floorCount push_cast rw [hg, he] simp only [Int.cast_natCast] at * unfold floorError commonConst alpha beta gamma eta at * linear_combination -hf theorem skew_bounds {δ : ℝ} {L : ℕ} {E : ℝ} {a : ℝ × ℝ} (hδ : δ < 1) (ha : a ∈ good δ L E) : (-(1 / 2 : ℝ) ≤ gamma a ∧ gamma a ≤ 1 / 2) ∧ (-(1 / 2 : ℝ) ≤ eta δ a ∧ eta δ a ≤ 1 / 2) := by obtain ⟨⟨ha1, ha2⟩, _, _⟩ := ha unfold gamma eta constructor <;> constructor <;> linarith [ha1.1, ha1.2, ha2.1, ha2.2] /-- Both signed slopes are controlled by the explicit simultaneous event. -/ theorem centeredErrors_le {δ : ℝ} {L : ℕ} {E : ℝ} {a : ℝ × ℝ} (ha : a ∈ good δ L E) (q : GridPairs.Grid L) : |SkewGadget.centeredError L (gamma a) q.2| ≤ E ∧ |SkewGadget.centeredError L (eta δ a) q.1| ≤ E := by have hg := RotationAverage.row_error_le (-a.2) q.2.isLt have he := RotationAverage.row_error_le (δ - a.1) q.1.isLt rw [rowMajorant_neg] at hg have hγ : 2 * gamma a = -a.2 := by unfold gamma; ring have hη : 2 * eta δ a = δ - a.1 := by unfold eta; ring constructor · simpa only [SkewGadget.centeredError, hγ, Int.cast_natCast] using hg.trans ha.2.1 · simpa only [SkewGadget.centeredError, hη, Int.cast_natCast] using he.trans ha.2.2 theorem floorError_le {δ : ℝ} {L : ℕ} {E : ℝ} {a : ℝ × ℝ} (ha : a ∈ good δ L E) (q : GridPairs.Grid L) : |floorError δ L q a| ≤ 2 * E + 1 := by obtain ⟨hg, he⟩ := centeredErrors_le ha q have hf0 := Int.fract_nonneg (commonConst δ L a) have hf1 := Int.fract_lt_one (commonConst δ L a) rw [abs_le] at hg he ⊢ unfold floorError constructor <;> linarith [hg.1, hg.2, he.1, he.2] theorem score_error_le {B : Type*} {δ : ℝ} {L : ℕ} {E : ℝ} (Z0 : B × GridPairs.Grid L → ℤ) {a : ℝ × ℝ} (ha : a ∈ good δ L E) (i : B × GridPairs.Grid L) : |(score δ Z0 i a : ℝ) - ((Z0 i : ℝ) + alpha δ a * L * i.2.1.val + beta a * L * i.2.2.val)| ≤ 2 * E + 1 := by rw [score_affine, add_sub_cancel_left] exact floorError_le ha i.2 /-- Deterministic coarse errors cancel correctly within a block-row. -/ theorem rowDifference {K L : ℕ} {δ E : ℝ} (Z0 : RowPairAverage.Pin K L → ℤ) (D : Fin K → ℝ) (e : RowPairAverage.Pin K L → ℝ) (hZ0 : ∀ i, (Z0 i : ℝ) = D i.1 * (L : ℝ) ^ 2 + e i) : RowPairAverage.RowDifference (score δ Z0) e (good δ L E) δ (2 * E + 1) := by intro a ha i j hij have hb : i.1 = j.1 := congrArg (fun x : Fin K × Fin L => x.1) hij have hy : i.2.2 = j.2.2 := congrArg (fun x : Fin K × Fin L => x.2) hij have heq : ((score δ Z0 i a - score δ Z0 j a : ℤ) : ℝ) - ((1 - δ + a.1) * L * ((i.2.1.val : ℝ) - j.2.1.val) + (e i - e j)) = floorError δ L i.2 a - floorError δ L j.2 a := by rw [Int.cast_sub, score_affine, score_affine, hZ0 i, hZ0 j, hb, hy] unfold alpha ring rw [heq] have hi := abs_le.mp (floorError_le ha i.2) have hj := abs_le.mp (floorError_le ha j.2) rw [abs_le] constructor <;> linarith [hi.1, hi.2, hj.1, hj.2] /-- A fixed finite integer window, not a parameter-dependent choice of levels. -/ theorem score_range {B : Type*} {K L : ℕ} {δ E : ℝ} (Z0 : B × GridPairs.Grid L → ℤ) (D : B → ℝ) (e : B × GridPairs.Grid L → ℝ) (hZ0 : ∀ i, (Z0 i : ℝ) = D i.1 * (L : ℝ) ^ 2 + e i) (hD : ∀ b, 0 ≤ D b ∧ D b ≤ K) (he : ∀ i, |e i| ≤ (L : ℝ) ^ 2) (hδ : 0 < δ) (hδ1 : δ < 1) (hE : 2 * E + 1 ≤ (L : ℝ) ^ 2) {a : ℝ × ℝ} (ha : a ∈ good δ L E) (i : B × GridPairs.Grid L) : -(2 * (L : ℤ) ^ 2) ≤ score δ Z0 i a ∧ score δ Z0 i a ≤ ((K : ℤ) + 5) * (L : ℤ) ^ 2 := by have hα : 0 ≤ alpha δ a ∧ alpha δ a ≤ 1 := by unfold alpha constructor <;> linarith [ha.1.1.1, ha.1.1.2] have hβ : 0 ≤ beta a ∧ beta a ≤ 2 := by unfold beta constructor <;> linarith [ha.1.2.1, ha.1.2.2] have hx : (i.2.1.val : ℝ) ≤ L := by exact_mod_cast i.2.1.isLt.le have hy : (i.2.2.val : ℝ) ≤ L := by exact_mod_cast i.2.2.isLt.le have hAx0 : 0 ≤ alpha δ a * L * i.2.1.val := mul_nonneg (mul_nonneg hα.1 (Nat.cast_nonneg L)) (Nat.cast_nonneg _) have hBy0 : 0 ≤ beta a * L * i.2.2.val := mul_nonneg (mul_nonneg hβ.1 (Nat.cast_nonneg L)) (Nat.cast_nonneg _) have hAx : alpha δ a * L * i.2.1.val ≤ (L : ℝ) ^ 2 := by calc _ ≤ 1 * (L : ℝ) * L := mul_le_mul (mul_le_mul_of_nonneg_right hα.2 (Nat.cast_nonneg L)) hx (Nat.cast_nonneg _) (by positivity) _ = _ := by ring have hBy : beta a * L * i.2.2.val ≤ 2 * (L : ℝ) ^ 2 := by calc _ ≤ 2 * (L : ℝ) * L := mul_le_mul (mul_le_mul_of_nonneg_right hβ.2 (Nat.cast_nonneg L)) hy (Nat.cast_nonneg _) (by positivity) _ = _ := by ring have hD0 : 0 ≤ D i.1 * (L : ℝ) ^ 2 := mul_nonneg (hD i.1).1 (sq_nonneg _) have hDK : D i.1 * (L : ℝ) ^ 2 ≤ K * (L : ℝ) ^ 2 := mul_le_mul_of_nonneg_right (hD i.1).2 (sq_nonneg _) have herr := abs_le.mp (score_error_le Z0 ha i) have hei := abs_le.mp (he i) rw [hZ0 i] at herr have hlo : -(2 * (L : ℝ) ^ 2) ≤ (score δ Z0 i a : ℝ) := by linarith [herr.1, hei.1] have hhi : (score δ Z0 i a : ℝ) ≤ ((K : ℝ) + 5) * (L : ℝ) ^ 2 := by nlinarith [herr.2, hei.2] exact ⟨by exact_mod_cast hlo, by exact_mod_cast hhi⟩ /-- Actual coarse-grid pinned counts yield precisely these globally defined scores. The integer shift includes the floor of the real constant, not the constant itself. -/ theorem exists_score_extension {t L : ℕ} {δ E : ℝ} (p : Fin t ⊕ Fin t → ℕ) (z : Fin t ⊕ Fin t → GaussianInt) (hp : ∀ i, (p i).Prime) (hd : Function.Injective p) (hz : ∀ i, ¬(p i : GaussianInt) ∣ z i) (hinert : ∀ i, p i % 4 = 3) (hL : 0 < L) (hδ : 0 < δ) (hδ1 : δ < 1) (X : Finset Point) (hPX : CoarseGrid.pins L p z ⊆ X) {a : ℝ × ℝ} (ha : a ∈ good δ L E) : ∃ (Y : Finset Point) (C : ℕ), X ⊆ Y ∧ Y.card = X.card + C ∧ C ≤ 50 * t * L ^ 2 ∧ ∀ q : CoarseGrid.PinIndex t L, (pinnedCount Y (CoarseGrid.pin p z q) : ℤ) = score δ (fun i => (pinnedCount X (CoarseGrid.pin p z i) : ℤ)) q a + C + ⌊commonConst δ L a⌋ := by obtain ⟨hγ, hη⟩ := skew_bounds hδ1 ha obtain ⟨Y, C, hXY, hcard, hC, hcount⟩ := SkewGadgetRealization.exists_two_skew_extensions p z hp hd hz hinert hL (gamma a) (eta δ a) hγ hη X hPX refine ⟨Y, C, hXY, hcard, hC, ?_⟩ intro q have hx : 0 ≤ (q.2.1 : ℤ) ∧ (q.2.1 : ℤ) < L := ⟨by positivity, by exact_mod_cast q.2.1.isLt⟩ have hy : 0 ≤ (q.2.2 : ℤ) ∧ (q.2.2 : ℤ) < L := ⟨by positivity, by exact_mod_cast q.2.2.isLt⟩ have hg : ((SkewGadget.pairIndices L (gamma a) q.2.1 q.2.2).card : ℤ) = floorCount L (gamma a) q.2.1 q.2.2 := SkewGadget.pairIndices_card L (gamma a) q.2.1 q.2.2 hγ hx hy have he : ((SkewGadget.pairIndices L (eta δ a) q.2.2 q.2.1).card : ℤ) = floorCount L (eta δ a) q.2.2 q.2.1 := SkewGadget.pairIndices_card L (eta δ a) q.2.2 q.2.1 hη hy hx have hc := congrArg (fun n : ℕ => (n : ℤ)) (hcount q) push_cast at hc rw [hg, he] at hc unfold score dsimp only at hc ⊢ omega end DistanceCounts.SkewScores end end BodyFile084 -- Source: DistanceCounts/ProjectionGoodParameters.lean section BodyFile085 /-! The actual simultaneous good event has probability tending to one under the normalized restricted Lebesgue product law. The reflected first coordinate has exactly the same law, with the half-open endpoint discrepancy removed by nullity. -/ noncomputable section open Set MeasureTheory Filter open scoped Topology namespace DistanceCounts.ProjectionGoodParameters open ProjectionDensity ParameterKernel SkewParameters RotationAverage /-- Reflection exchanges the two half-open intervals. Their restricted Lebesgue measures agree because both endpoints are null. -/ theorem measurePreserving_uniform_reflection (δ : ℝ) : MeasurePreserving (fun r : ℝ => δ - r) (uniformIntervalMeasure δ) (uniformIntervalMeasure δ) := by have hpre : (fun r : ℝ => δ - r) ⁻¹' Ioc 0 δ = Ico 0 δ := by ext r simp only [mem_preimage, mem_Ioc, mem_Ico] constructor <;> rintro ⟨h₁, h₂⟩ <;> constructor <;> linarith have hr := (volume.measurePreserving_sub_left δ).restrict_preimage (measurableSet_Ioc (a := (0 : ℝ)) (b := δ)) rw [hpre, ← restrict_Ico_eq_restrict_Ioc] at hr exact hr.smul_measure (ENNReal.ofReal δ)⁻¹ /-- An identity of measures, not just an identity for continuous test functions. -/ theorem map_uniform_reflection (δ : ℝ) : (uniformIntervalMeasure δ).map (fun r : ℝ => δ - r) = uniformIntervalMeasure δ := (measurePreserving_uniform_reflection δ).map_eq theorem measurePreserving_parameter_snd {δ : ℝ} (hδ : 0 < δ) : MeasurePreserving (Prod.snd : ℝ × ℝ → ℝ) (parameterMeasure δ) (uniformIntervalMeasure 1) := by letI := uniformIntervalMeasure_probability hδ letI := uniformIntervalMeasure_probability (by norm_num : (0 : ℝ) < 1) exact measurePreserving_snd theorem measurePreserving_parameter_reflected_fst (δ : ℝ) : MeasurePreserving (fun a : ℝ × ℝ => δ - a.1) (parameterMeasure δ) (uniformIntervalMeasure δ) := by letI := uniformIntervalMeasure_probability (by norm_num : (0 : ℝ) < 1) exact (measurePreserving_uniform_reflection δ).comp measurePreserving_fst /-- The closed interval contains the entire normalized half-open interval law. -/ theorem uniformIntervalMeasure_Icc {δ : ℝ} (hδ : 0 < δ) : uniformIntervalMeasure δ (Icc 0 δ) = 1 := by have hi : Icc (0 : ℝ) δ ∩ Ico 0 δ = Ico 0 δ := inter_eq_right.mpr (fun _ hx => ⟨hx.1, hx.2.le⟩) simp [uniformIntervalMeasure, Measure.smul_apply, Measure.restrict_apply measurableSet_Icc, hi, hδ.ne', ENNReal.inv_mul_cancel, ENNReal.ofReal_ne_zero_iff.mpr hδ] theorem parameterMeasure_rectangle {δ : ℝ} (hδ : 0 < δ) : parameterMeasure δ (Icc (0 : ℝ) δ ×ˢ Icc (0 : ℝ) 1) = 1 := by letI := uniformIntervalMeasure_probability hδ letI := uniformIntervalMeasure_probability (by norm_num : (0 : ℝ) < 1) rw [parameterMeasure, Measure.prod_prod, uniformIntervalMeasure_Icc hδ, uniformIntervalMeasure_Icc (by norm_num : (0 : ℝ) < 1), mul_one] /-- The only losses are the two actual bad projections. This is a union bound; there is no assumption that the two bad events are independent. -/ theorem good_compl_mass_le {δ : ℝ} (hδ : 0 < δ) (L : ℕ) (E : ℝ) : (parameterMeasure δ).real (good δ L E)ᶜ ≤ (uniformIntervalMeasure δ).real (badAngles L E) + (uniformIntervalMeasure 1).real (badAngles L E) := by letI := parameterMeasure_probability hδ let R : Set (ℝ × ℝ) := Icc (0 : ℝ) δ ×ˢ Icc (0 : ℝ) 1 let B : Set (ℝ × ℝ) := (fun a : ℝ × ℝ => δ - a.1) ⁻¹' badAngles L E let A : Set (ℝ × ℝ) := (Prod.snd : ℝ × ℝ → ℝ) ⁻¹' badAngles L E have hR : (parameterMeasure δ).real Rᶜ = 0 := by rw [probReal_compl_eq_one_sub (measurableSet_Icc.prod measurableSet_Icc)] simp only [Measure.real, R, parameterMeasure_rectangle hδ, ENNReal.toReal_one, sub_self] have hB : (parameterMeasure δ).real B = (uniformIntervalMeasure δ).real (badAngles L E) := (measurePreserving_parameter_reflected_fst δ).measureReal_preimage (measurableSet_badAngles L E).nullMeasurableSet have hA : (parameterMeasure δ).real A = (uniformIntervalMeasure 1).real (badAngles L E) := (measurePreserving_parameter_snd hδ).measureReal_preimage (measurableSet_badAngles L E).nullMeasurableSet have hs : (good δ L E)ᶜ ⊆ Rᶜ ∪ (B ∪ A) := by intro a ha by_cases hr : a ∈ R · right by_cases hb : E < rowMajorant L (δ - a.1) · exact Or.inl hb · right change E < rowMajorant L a.2 by_contra hn exact ha ⟨hr, le_of_not_gt hn, le_of_not_gt hb⟩ · exact Or.inl hr calc (parameterMeasure δ).real (good δ L E)ᶜ ≤ (parameterMeasure δ).real (Rᶜ ∪ (B ∪ A)) := measureReal_mono hs _ ≤ (parameterMeasure δ).real Rᶜ + (parameterMeasure δ).real (B ∪ A) := measureReal_union_le _ _ _ ≤ (parameterMeasure δ).real Rᶜ + ((parameterMeasure δ).real B + (parameterMeasure δ).real A) := add_le_add (le_refl _) (measureReal_union_le B A) _ = _ := by rw [hR, hB, hA, zero_add] /-- The complement vanishes at the unchanged discrepancy exponent `1/10`. -/ theorem tendsto_good_compl_mass {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ ≤ 1) : Tendsto (fun L : ℕ => (parameterMeasure δ).real (good δ L ((L : ℝ) ^ (1 / 10 : ℝ)))ᶜ) atTop (𝓝 0) := by have hu := (tendsto_badAngles_mass hδ hδ1).add (tendsto_badAngles_mass (by norm_num : (0 : ℝ) < 1) le_rfl) simp only [zero_add] at hu apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds hu · exact Eventually.of_forall fun _ => ENNReal.toReal_nonneg · exact Eventually.of_forall fun L => good_compl_mass_le hδ L _ /-- The canonical measurable simultaneous event has probability tending to one. -/ theorem tendsto_good_mass {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ ≤ 1) : Tendsto (fun L : ℕ => (parameterMeasure δ).real (good δ L ((L : ℝ) ^ (1 / 10 : ℝ)))) atTop (𝓝 1) := by letI := parameterMeasure_probability hδ have he : (fun L : ℕ => (parameterMeasure δ).real (good δ L ((L : ℝ) ^ (1 / 10 : ℝ)))) = (fun L : ℕ => 1 - (parameterMeasure δ).real (good δ L ((L : ℝ) ^ (1 / 10 : ℝ)))ᶜ) := by funext L rw [probReal_compl_eq_one_sub (measurableSet_good δ L _)] ring rw [he] simpa only [sub_zero] using tendsto_const_nhds.sub (tendsto_good_compl_mass hδ hδ1) theorem eventually_good_mass_ge_half {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ ≤ 1) : ∀ᶠ L : ℕ in atTop, (1 / 2 : ℝ) ≤ (parameterMeasure δ).real (good δ L ((L : ℝ) ^ (1 / 10 : ℝ))) := by filter_upwards [(tendsto_good_mass hδ hδ1).eventually_const_lt (by norm_num : (1 / 2 : ℝ) < 1)] with L hL exact hL.le end DistanceCounts.ProjectionGoodParameters end end BodyFile085 -- Source: DistanceCounts/ParameterSelection.lean section BodyFile086 /-! First-moment selection inside a genuine positive-probability good event. -/ namespace DistanceCounts.ParameterSelection open MeasureTheory Set /-- No independence between the good event and the cost is assumed. -/ theorem exists_good_le_twice_integral {Ω : Type*} [MeasurableSpace Ω] {μ : Measure Ω} [IsProbabilityMeasure μ] {good : Set Ω} {f : Ω → ℝ} (hgood : (1 / 2 : ℝ) ≤ μ.real good) (hf : Integrable f μ) (hf0 : 0 ≤ᵐ[μ] f) : ∃ a ∈ good, f a ≤ 2 * ∫ x, f x ∂μ := by have hpos : 0 < μ.real good := lt_of_lt_of_le (by norm_num) hgood have hn : μ good ≠ 0 := by intro hzero have hr : μ.real good = 0 := by simp only [measureReal_def, hzero, ENNReal.toReal_zero] linarith obtain ⟨a, ha, hfa⟩ := exists_le_setAverage hn (measure_ne_top μ good) hf.integrableOn rw [setAverage_eq, smul_eq_mul] at hfa have hinv : (μ.real good)⁻¹ ≤ (2 : ℝ) := by rw [← one_div] apply (div_le_iff₀ hpos).mpr linarith refine ⟨a, ha, hfa.trans ?_⟩ calc (μ.real good)⁻¹ * (∫ x in good, f x ∂μ) ≤ (μ.real good)⁻¹ * ∫ x, f x ∂μ := mul_le_mul_of_nonneg_left (setIntegral_le_integral hf hf0) (inv_nonneg.mpr hpos.le) _ ≤ 2 * ∫ x, f x ∂μ := mul_le_mul_of_nonneg_right hinv (integral_nonneg_of_ae hf0) end DistanceCounts.ParameterSelection end BodyFile086 -- Source: DistanceCounts/FineParameterChoice.lean section BodyFile087 /-! A common numerical parameter is chosen before any geometric extension. -/ noncomputable section open Filter MeasureTheory Set open scoped Topology BigOperators namespace DistanceCounts.FineParameterChoice open ParameterKernel ConstructionScales /-- A deterministic envelope, independent of the projection parameters. -/ def perturbationEnvelope (r : ℕ → ℝ) (L : ℕ) : ℝ := |r L| + h L + 1 / (L : ℝ) ^ 2 theorem perturbation_le {K L : ℕ} (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) {r : ℝ} (hL : 0 < L) (herr : ∀ i, |FineData.error D Z0 i| ≤ r * (L : ℝ) ^ 2) (b : Fin K) (p : GridPairs.Grid L) : |FineData.perturbation D Z0 (H L) b p| ≤ |r| + h L + 1 / (L : ℝ) ^ 2 := by have hm : 0 < (L : ℝ) ^ 2 := by positivity have he : |FineData.error D Z0 (b, p) / (L : ℝ) ^ 2| ≤ |r| := by rw [abs_div, abs_of_nonneg (sq_nonneg (L : ℝ))] apply (div_le_iff₀ hm).mpr exact (herr (b, p)).trans (mul_le_mul_of_nonneg_right (le_abs_self r) hm.le) have hh : 0 ≤ (H L : ℝ) / (L : ℝ) ^ 2 := by positivity have hu : 0 ≤ 1 / (L : ℝ) ^ 2 := by positivity calc _ ≤ |FineData.error D Z0 (b, p) / (L : ℝ) ^ 2 - (H L : ℝ) / (L : ℝ) ^ 2| + |1 / (L : ℝ) ^ 2| := abs_add_le _ _ _ ≤ (|FineData.error D Z0 (b, p) / (L : ℝ) ^ 2| + |(H L : ℝ) / (L : ℝ) ^ 2|) + |1 / (L : ℝ) ^ 2| := add_le_add (abs_sub _ _) le_rfl _ ≤ |r| + h L + 1 / (L : ℝ) ^ 2 := by rw [abs_of_nonneg hh, abs_of_nonneg hu] exact add_le_add (add_le_add he (le_refl (h L))) le_rfl theorem tendsto_perturbationEnvelope {r : ℕ → ℝ} (hr : Tendsto r atTop (𝓝 0)) : Tendsto (perturbationEnvelope r) atTop (𝓝 0) := by have hi : Tendsto (fun L : ℕ => 1 / (L : ℝ) ^ 2) atTop (𝓝 0) := by have hp : Tendsto (fun L : ℕ => (L : ℝ) ^ 2) atTop atTop := by simpa only [Function.comp_def] using (tendsto_pow_atTop (by decide : 2 ≠ 0)).comp (tendsto_natCast_atTop_atTop : Tendsto (fun L : ℕ => (L : ℝ)) atTop atTop) simpa only [Function.comp_def, one_div] using (tendsto_inv_atTop_zero : Tendsto (fun x : ℝ => x⁻¹) atTop (𝓝 0)).comp hp unfold perturbationEnvelope simpa only [abs_zero, add_zero] using (hr.abs.add tendsto_h).add hi private theorem eventually_h_pos : ∀ᶠ L : ℕ in atTop, 0 < h L := by filter_upwards [tendsto_H.eventually (eventually_gt_atTop 0), eventually_gt_atTop 0] with L hH hL unfold h positivity /-- The sum includes every original block, not just a witness subset. -/ def empiricalCost {K L : ℕ} (δ : ℝ) (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (a : ℝ × ℝ) : ℝ := ∑ b : Fin K, MesoscopicProjection.squareError L δ (h L) (FineData.perturbation D Z0 (H L) b) a /-- The actual ordered distinct same-row count, restricted only in the integrand. -/ def nearCost {K L : ℕ} (δ : ℝ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (a : ℝ × ℝ) : ℝ := (SkewParameters.good δ L (E L)).indicator (RowPairAverage.count (SkewScores.score δ Z0) (B K L : ℤ)) a / (L : ℝ) ^ 2 /-- Both statistics are charged to one nonnegative cost, with no independence claim. -/ def cost {K L : ℕ} (δ : ℝ) (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (a : ℝ × ℝ) : ℝ := empiricalCost δ D Z0 a + nearCost δ Z0 a theorem empiricalCost_nonneg {K L : ℕ} (δ : ℝ) (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (a : ℝ × ℝ) : 0 ≤ empiricalCost δ D Z0 a := Finset.sum_nonneg fun b _ => MesoscopicProjection.squareError_nonneg _ _ _ _ _ theorem nearCost_nonneg {K L : ℕ} (δ : ℝ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (a : ℝ × ℝ) : 0 ≤ nearCost δ Z0 a := by apply div_nonneg _ (sq_nonneg _) exact Set.indicator_nonneg (fun a _ => Nat.cast_nonneg _) a theorem cost_nonneg {K L : ℕ} (δ : ℝ) (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (a : ℝ × ℝ) : 0 ≤ cost δ D Z0 a := add_nonneg (empiricalCost_nonneg δ D Z0 a) (nearCost_nonneg δ Z0 a) theorem integrable_empiricalCost {K L : ℕ} {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (hL : 0 < L) (hh : 0 < h L) (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) : Integrable (empiricalCost δ D Z0) (parameterMeasure δ) := integrable_finsetSum _ fun b _ => MesoscopicProjection.integrable_squareError hL hδ hδ1 hh _ theorem integrable_nearCost {K L : ℕ} {δ : ℝ} (hδ : 0 < δ) (Z0 : Fin K × GridPairs.Grid L → ℤ) : Integrable (nearCost δ Z0) (parameterMeasure δ) := (RowPairAverage.integrable_good_count hδ (SkewScores.measurable_score δ Z0) (B K L : ℤ) (SkewParameters.measurableSet_good δ L (E L))).div_const _ theorem integrable_cost {K L : ℕ} {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (hL : 0 < L) (hh : 0 < h L) (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) : Integrable (cost δ D Z0) (parameterMeasure δ) := (integrable_empiricalCost hδ hδ1 hL hh D Z0).add (integrable_nearCost hδ Z0) /-- The coarse degree cancels within a row; only the literal floor errors remain. -/ theorem rowDifference {K L : ℕ} (δ : ℝ) (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) : RowPairAverage.RowDifference (SkewScores.score δ Z0) (FineData.error D Z0) (SkewParameters.good δ L (E L)) δ (2 * E L + 1) := SkewScores.rowDifference Z0 (fun b => (D b : ℝ)) (FineData.error D Z0) (FineData.decomposition D Z0) theorem tendsto_integral_empiricalCost {K : ℕ} {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (D : Fin K → ℤ) (Z0 : (L : ℕ) → Fin K × GridPairs.Grid L → ℤ) {r : ℕ → ℝ} (hr : Tendsto r atTop (𝓝 0)) (herr : ∀ᶠ L in atTop, ∀ i, |FineData.error D (Z0 L) i| ≤ r L * (L : ℝ) ^ 2) : Tendsto (fun L => ∫ a, empiricalCost δ D (Z0 L) a ∂parameterMeasure δ) atTop (𝓝 0) := by have hb (b : Fin K) : Tendsto (fun L => MesoscopicProjection.expectedSquareError L δ (h L) (FineData.perturbation D (Z0 L) (H L) b)) atTop (𝓝 0) := by apply MesoscopicProjection.tendsto_expectedSquareError hδ hδ1 _ eventually_h_pos tendsto_h tendsto_square_mul_h (tendsto_perturbationEnvelope hr) filter_upwards [herr, eventually_gt_atTop 0] with L he hL exact fun p => perturbation_le D (Z0 L) hL he b p have ht := tendsto_finset_sum (Finset.univ : Finset (Fin K)) (fun b _ => hb b) simp only [Finset.sum_const_zero] at ht apply ht.congr' filter_upwards [eventually_h_pos, eventually_gt_atTop 0] with L hh hL symm exact integral_finsetSum _ fun b _ => MesoscopicProjection.integrable_squareError hL hδ hδ1 hh _ theorem integral_nearCost_le {K L : ℕ} {δ : ℝ} (hδ : 0 < δ) (hL : 0 < L) (hB : 0 < B K L) (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) : (∫ a, nearCost δ Z0 a ∂parameterMeasure δ) ≤ (4 / δ) * ((K : ℝ) * ((B K L : ℝ) + 4 * E L + 2) * (1 + Real.log L) / L) := by have hE : 0 ≤ 2 * E L + 1 := by unfold E; positivity have hBi : (0 : ℤ) < B K L := by exact_mod_cast hB have hb := RowPairAverage.integral_good_count_le hδ hL hE hBi (SkewScores.measurable_score δ Z0) (SkewParameters.measurableSet_good δ L (E L)) (rowDifference δ D Z0) have hLr : (L : ℝ) ≠ 0 := by exact_mod_cast hL.ne' calc (∫ a : ℝ × ℝ, nearCost δ Z0 a ∂parameterMeasure δ) = (∫ a : ℝ × ℝ, (SkewParameters.good δ L (E L)).indicator (RowPairAverage.count (SkewScores.score δ Z0) (B K L : ℤ)) a ∂parameterMeasure δ) / (L : ℝ) ^ 2 := by simp only [nearCost, div_eq_mul_inv, integral_mul_const] _ ≤ (4 / δ * K * L * (((B K L : ℤ) : ℝ) + 2 * (2 * E L + 1)) * (1 + Real.log L)) / (L : ℝ) ^ 2 := div_le_div_of_nonneg_right hb (sq_nonneg _) _ = _ := by push_cast; field_simp [hLr]; ring theorem tendsto_integral_nearCost {K : ℕ} (hK : 0 < K) {δ : ℝ} (hδ : 0 < δ) (D : Fin K → ℤ) (Z0 : (L : ℕ) → Fin K × GridPairs.Grid L → ℤ) : Tendsto (fun L => ∫ a, nearCost δ (Z0 L) a ∂parameterMeasure δ) atTop (𝓝 0) := by have ht := (tendsto_rowMoment hK).const_mul (4 / δ) simp only [mul_zero] at ht apply squeeze_zero' (Eventually.of_forall fun L => integral_nonneg (nearCost_nonneg δ (Z0 L))) _ ht filter_upwards [eventually_pos hK, eventually_gt_atTop 0] with L hp hL exact integral_nearCost_le hδ hL hp.2.1 D (Z0 L) theorem tendsto_integral_cost {K : ℕ} (hK : 0 < K) {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (D : Fin K → ℤ) (Z0 : (L : ℕ) → Fin K × GridPairs.Grid L → ℤ) {r : ℕ → ℝ} (hr : Tendsto r atTop (𝓝 0)) (herr : ∀ᶠ L in atTop, ∀ i, |FineData.error D (Z0 L) i| ≤ r L * (L : ℝ) ^ 2) : Tendsto (fun L => ∫ a, cost δ D (Z0 L) a ∂parameterMeasure δ) atTop (𝓝 0) := by have ht := (tendsto_integral_empiricalCost hδ hδ1 D Z0 hr herr).add (tendsto_integral_nearCost hK hδ D Z0) simp only [add_zero] at ht apply ht.congr' filter_upwards [eventually_h_pos, eventually_gt_atTop 0] with L hh hL exact (integral_add (integrable_empiricalCost hδ hδ1 hL hh D (Z0 L)) (integrable_nearCost hδ (Z0 L))).symm /-- An actual common parameter controls the full empirical sum and the actual ordered near count. The envelope is nonnegative even at the early degenerate scales. -/ theorem exists_parameters {K : ℕ} (hK : 0 < K) {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (D : Fin K → ℤ) (Z0 : (L : ℕ) → Fin K × GridPairs.Grid L → ℤ) {r : ℕ → ℝ} (hr : Tendsto r atTop (𝓝 0)) (herr : ∀ᶠ L in atTop, ∀ i, |FineData.error D (Z0 L) i| ≤ r L * (L : ℝ) ^ 2) : ∃ ω : ℕ → ℝ, (∀ L, 0 ≤ ω L) ∧ Tendsto ω atTop (𝓝 0) ∧ ∀ᶠ L in atTop, ∃ a ∈ SkewParameters.good δ L (E L), empiricalCost δ D (Z0 L) a ≤ ω L ∧ RowPairAverage.count (SkewScores.score δ (Z0 L)) (B K L : ℤ) a / (L : ℝ) ^ 2 ≤ ω L := by letI := parameterMeasure_probability hδ let ω : ℕ → ℝ := fun L => 2 * ∫ a, cost δ D (Z0 L) a ∂parameterMeasure δ refine ⟨ω, (fun L => mul_nonneg (by norm_num) (integral_nonneg (cost_nonneg δ D (Z0 L)))), ?_, ?_⟩ · simpa only [ω, mul_zero] using (tendsto_integral_cost hK hδ hδ1 D Z0 hr herr).const_mul 2 · filter_upwards [ProjectionGoodParameters.eventually_good_mass_ge_half hδ hδ1.le, eventually_h_pos, eventually_gt_atTop 0] with L hg hh hL obtain ⟨a, ha, hc⟩ := ParameterSelection.exists_good_le_twice_integral hg (integrable_cost hδ hδ1 hL hh D (Z0 L)) (Eventually.of_forall (cost_nonneg δ D (Z0 L))) change a ∈ SkewParameters.good δ L (E L) at ha change empiricalCost δ D (Z0 L) a + nearCost δ (Z0 L) a ≤ ω L at hc refine ⟨a, ha, ?_, ?_⟩ · exact (le_add_of_nonneg_right (nearCost_nonneg δ (Z0 L) a)).trans hc · have hn : RowPairAverage.count (SkewScores.score δ (Z0 L)) (B K L : ℤ) a / (L : ℝ) ^ 2 = nearCost δ (Z0 L) a := by simp only [nearCost, Set.indicator_of_mem ha] rw [hn] exact (le_add_of_nonneg_left (empiricalCost_nonneg δ D (Z0 L) a)).trans hc end DistanceCounts.FineParameterChoice end end BodyFile087 -- Source: DistanceCounts/CountIntensity.lean section BodyFile088 /-! Integer-bin occupancies and the exact continuous intensity of uniform integer jitter. -/ noncomputable section namespace DistanceCounts.CountIntensity open Finset MeasureTheory open scoped Classical /-- Actual occupancy after the integer levels have been chosen. -/ def binCount {M : ℕ} (Y : Fin M → ℤ) (B j : ℤ) : ℕ := (univ.filter (fun i => Y i / B = j)).card /-- The exact mean occupancy for a uniform shift from `0,...,H-1` at every pin. -/ def jitterMean {M : ℕ} (H : ℕ) (Z : Fin M → ℤ) (B j : ℤ) : ℝ := (H : ℝ)⁻¹ * ∑ i : Fin M, ((univ.filter (fun r : Fin H => (Z i - (r.val : ℤ)) / B = j)).card : ℝ) /-- Each possible integer output contributes its actual unit interval. -/ def intensity {M : ℕ} (H : ℕ) (Z : Fin M → ℤ) (t : ℝ) : ℝ := ∑ i : Fin M, ProjectionDensity.box (H : ℝ) (t - ((Z i - (H : ℤ) + 1 : ℤ) : ℝ)) theorem binCount_cast {M : ℕ} (Y : Fin M → ℤ) (B j : ℤ) : (binCount Y B j : ℝ) = ∑ i : Fin M, if Y i / B = j then (1 : ℝ) else 0 := by simp only [binCount, Finset.sum_boole] theorem jitterMean_nonneg {M : ℕ} (H : ℕ) (Z : Fin M → ℤ) (B j : ℤ) : 0 ≤ jitterMean H Z B j := by unfold jitterMean positivity theorem intensity_nonneg {M H : ℕ} (hH : 0 < H) (Z : Fin M → ℤ) (t : ℝ) : 0 ≤ intensity H Z t := by exact sum_nonneg fun _ _ => ProjectionDensity.box_nonneg (by exact_mod_cast hH) _ end DistanceCounts.CountIntensity end end BodyFile088 -- Source: DistanceCounts/HistogramIntensity.lean section BodyFile089 noncomputable section namespace DistanceCounts.CountIntensity open Set MeasureTheory open scoped Classical /-- The actual half-open unit cell of an integer output. -/ def unitCell (n : ℤ) : ℝ → ℝ := (Ico (n : ℝ) ((n : ℝ) + 1)).indicator (fun _ => 1) theorem integrable_unitCell (n : ℤ) : Integrable (unitCell n) := by exact (integrableOn_const (by simp : volume (Ico (n : ℝ) ((n : ℝ) + 1)) ≠ ⊤)).integrable_indicator measurableSet_Ico theorem integral_unitCell (n : ℤ) : ∫ t, unitCell n t = 1 := by simp [unitCell, integral_indicator_const, Real.volume_real_Ico, smul_eq_mul] private theorem adjacent_cells (a b c t : ℝ) (hab : a ≤ b) (hbc : b ≤ c) : (Ico b c).indicator (fun _ : ℝ => (1 : ℝ)) t + (Ico a b).indicator (fun _ : ℝ => (1 : ℝ)) t = (Ico a c).indicator (fun _ : ℝ => (1 : ℝ)) t := by simp only [Set.indicator, mem_Ico] split_ifs <;> grind /-- Exact pointwise tiling, including both endpoint conventions and negative centers. -/ theorem sum_unitCell (H : ℕ) (z : ℤ) (t : ℝ) : ∑ r : Fin H, unitCell (z - (r.val : ℤ)) t = (Ico ((z : ℝ) - H + 1) ((z : ℝ) + 1)).indicator (fun _ => 1) t := by induction H with | zero => simp | succ H ih => rw [Fin.sum_univ_castSucc] simp only [Fin.val_castSucc, Fin.val_last, ih] have he : (z : ℝ) - (↑(H + 1) : ℝ) + 1 = (z : ℝ) - H := by push_cast ring rw [he] have hc : unitCell (z - (H : ℤ)) t = (Ico ((z : ℝ) - H) ((z : ℝ) - H + 1)).indicator (fun _ => 1) t := by simp only [unitCell, Int.cast_sub, Int.cast_natCast] rw [hc] exact adjacent_cells _ _ _ _ (by linarith) (by have : (0 : ℝ) ≤ H := Nat.cast_nonneg H; linarith) /-- The normalized long box is precisely the average of the integer-output cells. -/ theorem box_eq_mean_unitCell (H : ℕ) (z : ℤ) (t : ℝ) : ProjectionDensity.box (H : ℝ) (t - ((z - (H : ℤ) + 1 : ℤ) : ℝ)) = (H : ℝ)⁻¹ * ∑ r : Fin H, unitCell (z - (r.val : ℤ)) t := by rw [sum_unitCell, EmpiricalEnergy.box_translate] have ha : ((z - (H : ℤ) + 1 : ℤ) : ℝ) = (z : ℝ) - H + 1 := by simp only [Int.cast_add, Int.cast_sub, Int.cast_one, Int.cast_natCast] rw [ha] have hb : (z : ℝ) - H + 1 + H = (z : ℝ) + 1 := by ring rw [hb] by_cases ht : t ∈ Ico ((z : ℝ) - H + 1) ((z : ℝ) + 1) <;> simp [Set.indicator, ht, one_div] /-- A unit cell never straddles an integer bin boundary. -/ theorem unitCell_mem_bin {B : ℤ} (hB : 0 < B) (j n : ℤ) {t : ℝ} (ht : t ∈ Ico (n : ℝ) ((n : ℝ) + 1)) : t ∈ Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ) ↔ n / B = j := by rw [Int.ediv_eq_iff_of_pos hB] constructor · intro hj constructor · by_contra hn have hn' : n + 1 ≤ j * B := by omega have hn'' : (n : ℝ) + 1 ≤ ((j * B : ℤ) : ℝ) := by exact_mod_cast hn' linarith [ht.2, hj.1] · have hn : (n : ℝ) < (((j + 1) * B : ℤ) : ℝ) := lt_of_le_of_lt ht.1 hj.2 have hn' : n < (j + 1) * B := by exact_mod_cast hn nlinarith · rintro ⟨hlo, hhi⟩ have hlo' : ((j * B : ℤ) : ℝ) ≤ (n : ℝ) := by exact_mod_cast hlo have hhi' : n + 1 ≤ (j + 1) * B := by nlinarith have hhi'' : (n : ℝ) + 1 ≤ (((j + 1) * B : ℤ) : ℝ) := by exact_mod_cast hhi' exact ⟨hlo'.trans ht.1, ht.2.trans_le hhi''⟩ /-- Exact cell/bin intersection, not an almost-everywhere replacement. -/ theorem bin_indicator_unitCell {B : ℤ} (hB : 0 < B) (j n : ℤ) (t : ℝ) : (Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ)).indicator (unitCell n) t = if n / B = j then unitCell n t else 0 := by by_cases ht : t ∈ Ico (n : ℝ) ((n : ℝ) + 1) · have hm := unitCell_mem_bin hB j n ht by_cases hj : n / B = j · rw [Set.indicator_of_mem (hm.mpr hj), if_pos hj] · have hnot : t ∉ Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ) := fun h => hj (hm.mp h) rw [Set.indicator_of_notMem hnot, if_neg hj] · have hz : unitCell n t = 0 := Set.indicator_of_notMem ht _ simp only [Set.indicator, hz, ite_self] theorem integral_unitCell_bin {B : ℤ} (hB : 0 < B) (j n : ℤ) : (∫ t in Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ), unitCell n t) = if n / B = j then (1 : ℝ) else 0 := by rw [← integral_indicator measurableSet_Ico] simp_rw [bin_indicator_unitCell hB] by_cases hj : n / B = j <;> simp [hj, integral_unitCell] theorem measurable_intensity {M : ℕ} (H : ℕ) (Z : Fin M → ℤ) : Measurable (intensity H Z) := by exact Finset.measurable_sum Finset.univ fun i _ => (ProjectionDensity.measurable_box _).comp (measurable_id.sub measurable_const) theorem integrable_intensity {M : ℕ} (H : ℕ) (Z : Fin M → ℤ) : Integrable (intensity H Z) := by exact integrable_finsetSum Finset.univ fun i _ => EmpiricalEnergy.integrable_box_translate _ _ theorem integral_intensity {M H : ℕ} (hH : 0 < H) (Z : Fin M → ℤ) : ∫ t, intensity H Z t = (M : ℝ) := by unfold intensity rw [integral_finsetSum Finset.univ (fun i _ => EmpiricalEnergy.integrable_box_translate _ _)] simp [EmpiricalEnergy.integral_box_translate (show (0 : ℝ) < H by exact_mod_cast hH)] /-- The discrete mean equals integration of its actual continuous intensity. -/ theorem jitterMean_eq_integral {M H : ℕ} (hH : 0 < H) (Z : Fin M → ℤ) {B : ℤ} (hB : 0 < B) (j : ℤ) : jitterMean H Z B j = ∫ t in Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ), intensity H Z t := by unfold intensity rw [integral_finsetSum (μ := volume.restrict (Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ))) (f := fun i : Fin M => fun t : ℝ => ProjectionDensity.box (H : ℝ) (t - ((Z i - (H : ℤ) + 1 : ℤ) : ℝ))) Finset.univ (fun i _ => (EmpiricalEnergy.integrable_box_translate _ _).integrableOn)] simp_rw [box_eq_mean_unitCell, integral_const_mul] rw [← Finset.mul_sum] unfold jitterMean congr 1 apply Finset.sum_congr rfl intro i hi rw [integral_finsetSum (μ := volume.restrict (Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ))) (f := fun r : Fin H => fun t : ℝ => unitCell (Z i - (r.val : ℤ)) t) Finset.univ (fun r _ => (integrable_unitCell (Z i - (r.val : ℤ))).integrableOn)] simp_rw [integral_unitCell_bin hB] simp only [Finset.sum_boole] /-- The positive excess is integrable even though the constant function one is not. -/ theorem integrable_intensity_excess {M H : ℕ} (hH : 0 < H) (Z : Fin M → ℤ) : Integrable (fun t => max 0 (intensity H Z t - 1)) := by apply (integrable_intensity H Z).mono' · exact (measurable_const.max ((measurable_intensity H Z).sub measurable_const)).aestronglyMeasurable · filter_upwards with t rw [Real.norm_eq_abs, abs_of_nonneg (le_max_left _ _)] exact max_le (intensity_nonneg hH Z t) (by linarith) /-- Distinct integer bins are genuinely disjoint, including their endpoints. -/ theorem intensity_bin_unique {B : ℤ} (hB : 0 < B) {j k : ℤ} {t : ℝ} (hj : t ∈ Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ)) (hk : t ∈ Ico ((k * B : ℤ) : ℝ) (((k + 1) * B : ℤ) : ℝ)) : j = k := by have hBr : (0 : ℝ) < B := by exact_mod_cast hB push_cast at hj hk rcases lt_trichotomy j k with h | h | h · have h' : j + 1 ≤ k := by omega have h'' : (j : ℝ) + 1 ≤ k := by exact_mod_cast h' nlinarith [hj.2, hk.1] · exact h · have h' : k + 1 ≤ j := by omega have h'' : (k : ℝ) + 1 ≤ j := by exact_mod_cast h' nlinarith [hk.2, hj.1] theorem integral_one_bin {B : ℤ} (hB : 0 < B) (j : ℤ) : (∫ _t : ℝ in Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ), (1 : ℝ)) = (B : ℝ) := by rw [setIntegral_const, Real.volume_real_Ico] have he : (((j + 1) * B : ℤ) : ℝ) - ((j * B : ℤ) : ℝ) = (B : ℝ) := by push_cast ring rw [he, max_eq_left (show (0 : ℝ) ≤ B by exact_mod_cast hB.le)] simp theorem jitterMean_excess_le_bin_integral {M H : ℕ} (hH : 0 < H) (Z : Fin M → ℤ) {B : ℤ} (hB : 0 < B) (j : ℤ) : max 0 (jitterMean H Z B j - (B : ℝ)) ≤ ∫ t in Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ), max 0 (intensity H Z t - 1) := by have hc : IntegrableOn (fun _ : ℝ => (1 : ℝ)) (Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ)) := integrableOn_const (by simp) apply max_le · exact integral_nonneg fun t => le_max_left _ _ · rw [jitterMean_eq_integral hH Z hB j, ← integral_one_bin hB j, ← integral_sub (integrable_intensity H Z).integrableOn hc] exact integral_mono ((integrable_intensity H Z).integrableOn.sub hc) (integrable_intensity_excess hH Z).integrableOn (fun t => le_max_right _ _) /-- Expected overflow over any finite family of bins is bounded by the global Lebesgue excess of the actual intensity. -/ theorem sum_jitterMean_excess_le_integral {M H : ℕ} (hH : 0 < H) (Z : Fin M → ℤ) {B : ℤ} (hB : 0 < B) (J : Finset ℤ) : ∑ j ∈ J, max 0 (jitterMean H Z B j - (B : ℝ)) ≤ ∫ t, max 0 (intensity H Z t - 1) := by let f : ℝ → ℝ := fun t => max 0 (intensity H Z t - 1) have hf : Integrable f := integrable_intensity_excess hH Z have hnonneg : ∀ t, 0 ≤ f t := fun t => le_max_left _ _ let g : ℤ → ℝ → ℝ := fun j => (Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ)).indicator f have hg : ∀ j, Integrable (g j) := fun j => hf.indicator measurableSet_Ico have hsum : ∀ t, ∑ j ∈ J, g j t ≤ f t := by intro t by_cases ht : ∃ k ∈ J, t ∈ Ico ((k * B : ℤ) : ℝ) (((k + 1) * B : ℤ) : ℝ) · obtain ⟨k, hk, hkt⟩ := ht rw [Finset.sum_eq_single k] · change (Ico ((k * B : ℤ) : ℝ) (((k + 1) * B : ℤ) : ℝ)).indicator f t ≤ f t rw [Set.indicator_of_mem hkt] · intro j hj hjk have hnot : t ∉ Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ) := fun hjt => hjk (intensity_bin_unique hB hjt hkt) exact Set.indicator_of_notMem hnot f · exact fun hnot => (hnot hk).elim · have hz : ∀ j ∈ J, g j t = 0 := by intro j hj have hnot : t ∉ Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ) := fun hjt => ht ⟨j, hj, hjt⟩ exact Set.indicator_of_notMem hnot f rw [Finset.sum_eq_zero hz] exact hnonneg t calc _ ≤ ∑ j ∈ J, ∫ t in Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ), f t := Finset.sum_le_sum fun j _ => jitterMean_excess_le_bin_integral hH Z hB j _ = ∑ j ∈ J, ∫ t, g j t := by apply Finset.sum_congr rfl intro j hj exact (integral_indicator (μ := volume) (f := f) (s := Ico ((j * B : ℤ) : ℝ) (((j + 1) * B : ℤ) : ℝ)) measurableSet_Ico).symm _ = ∫ t, ∑ j ∈ J, g j t := (integral_finsetSum J (fun j _ => hg j)).symm _ ≤ _ := integral_mono (integrable_finsetSum J (fun j _ => hg j)) hf hsum end DistanceCounts.CountIntensity end end BodyFile089 -- Source: DistanceCounts/AggregateDensity.lean section BodyFile090 /-! Pointwise excess bounds for actual finite families of translated projection laws. -/ noncomputable section namespace DistanceCounts.AggregateDensity open Set MeasureTheory open ProjectionDensity EmpiricalEnergy EmpiricalPairKernel open scoped BigOperators /-- The actual parameter rectangle; allowing its boundary only strengthens the estimates. -/ def rectangle (δ : ℝ) : Set (ℝ × ℝ) := Icc 0 δ ×ˢ Icc 0 1 variable {J : Type*} [Fintype J] /-- Only the designated witness blocks are summed; no operation on other points is involved. -/ def aggregate {L : ℕ} (D : J → ℤ) (h : ℝ) (w : J → GridPairs.Grid L → ℝ) (t : ℝ) : ℝ := ∑ j, smoothed (w j) h (t - (D j : ℝ)) def reference (D : J → ℤ) (δ : ℝ) (a : ℝ × ℝ) (t : ℝ) : ℝ := ∑ j, density (1 - δ + a.1) (1 + a.2) (t - (D j : ℝ)) lemma parameter_bounds {δ : ℝ} (hδ1 : δ < 1) {a : ℝ × ℝ} (ha : a ∈ rectangle δ) : 0 < 1 - δ + a.1 ∧ 1 - δ + a.1 ≤ 1 ∧ 0 < 1 + a.2 ∧ 1 + a.2 ≤ 2 := by rcases ha with ⟨⟨ha0, haδ⟩, ⟨hb0, hb1⟩⟩ constructor · linarith constructor · linarith constructor <;> linarith lemma integrable_aggregate {L : ℕ} (D : J → ℤ) (h : ℝ) (w : J → GridPairs.Grid L → ℝ) : Integrable (aggregate D h w) := integrable_finsetSum _ fun j _ => (integrable_smoothed (w j) h).comp_sub_right _ lemma aggregate_nonneg {L : ℕ} (D : J → ℤ) {h : ℝ} (hh : 0 < h) (w : J → GridPairs.Grid L → ℝ) (t : ℝ) : 0 ≤ aggregate D h w t := Finset.sum_nonneg fun j _ => smoothed_nonneg (w j) hh _ lemma integrable_reference (D : J → ℤ) (δ : ℝ) (a : ℝ × ℝ) : Integrable (reference D δ a) := integrable_finsetSum _ fun j _ => (integrable_density _ _).comp_sub_right _ lemma reference_nonneg (D : J → ℤ) {δ : ℝ} (hδ1 : δ < 1) {a : ℝ × ℝ} (ha : a ∈ rectangle δ) (t : ℝ) : 0 ≤ reference D δ a t := by have hb := parameter_bounds hδ1 ha exact Finset.sum_nonneg fun j _ => density_nonneg hb.1 hb.2.2.1 _ lemma reference_le (D : J → ℤ) (hD : Function.Injective D) {δ : ℝ} (hδ1 : δ < 1) {a : ℝ × ℝ} (ha : a ∈ rectangle δ) (t : ℝ) : reference D δ a t ≤ 1 / (1 - δ + a.1) := by classical have hb := parameter_bounds hδ1 ha have hs := sum_density_integer_le hb.1 hb.2.1 hb.2.2.1 (Finset.univ.image D) t rw [Finset.sum_image (fun i _ j _ hij => hD hij)] at hs exact hs lemma reference_le_delta (D : J → ℤ) (hD : Function.Injective D) {δ : ℝ} (hδ1 : δ < 1) {a : ℝ × ℝ} (ha : a ∈ rectangle δ) (t : ℝ) : reference D δ a t ≤ 1 / (1 - δ) := by exact (reference_le D hD hδ1 ha t).trans (one_div_le_one_div_of_le (by linarith) (by linarith [ha.1.1])) lemma integral_reference (D : J → ℤ) {δ : ℝ} (hδ1 : δ < 1) {a : ℝ × ℝ} (ha : a ∈ rectangle δ) : (∫ t, reference D δ a t) = (Fintype.card J : ℝ) := by have hb := parameter_bounds hδ1 ha change (∫ t, ∑ j, density (1 - δ + a.1) (1 + a.2) (t - (D j : ℝ))) = _ rw [integral_finsetSum _ (fun j _ => (integrable_density _ _).comp_sub_right (D j : ℝ))] simp_rw [integral_sub_right_eq_self, integral_density hb.1 hb.2.2.1] simp /-- Positive excess is integrable without integrating the constant one over the line. -/ lemma integrable_excess {f : ℝ → ℝ} (hf : Integrable f) (hf0 : ∀ t, 0 ≤ f t) : Integrable (fun t => max 0 (f t - 1)) := by apply hf.mono' · exact (aemeasurable_const.max (hf.aestronglyMeasurable.aemeasurable.sub aemeasurable_const)).aestronglyMeasurable · exact Filter.Eventually.of_forall fun t => by rw [Real.norm_eq_abs, abs_of_nonneg (le_max_left _ _)] exact max_le (hf0 t) (by linarith) lemma integral_reference_excess_le (D : J → ℤ) (hD : Function.Injective D) {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) {a : ℝ × ℝ} (ha : a ∈ rectangle δ) : (∫ t, max 0 (reference D δ a t - 1)) ≤ δ * (Fintype.card J : ℝ) := by calc _ ≤ ∫ t, δ * reference D δ a t := by apply integral_mono (integrable_excess (integrable_reference D δ a) (reference_nonneg D hδ1 ha)) ((integrable_reference D δ a).const_mul δ) intro t have hbound := (le_div_iff₀ (show 0 < 1 - δ by linarith)).mp (reference_le_delta D hD hδ1 ha t) exact max_le (mul_nonneg hδ.le (reference_nonneg D hδ1 ha t)) (by nlinarith) _ = _ := by rw [integral_const_mul, integral_reference D hδ1 ha] lemma center_mem {L : ℕ} (hL : 0 < L) {δ : ℝ} (hδ1 : δ < 1) {a : ℝ × ℝ} (ha : a ∈ rectangle δ) {η : GridPairs.Grid L → ℝ} (hη : ∀ p, |η p| ≤ 1) (p : GridPairs.Grid L) : center L δ η a p ∈ Icc (-1 : ℝ) 4 := by have hb := parameter_bounds hδ1 ha have hp := GridQuadrature.sample_mem hL p have hp1 : 0 ≤ (GridQuadrature.sample L p).1 ∧ (GridQuadrature.sample L p).1 ≤ 1 := hp.1 have hp2 : 0 ≤ (GridQuadrature.sample L p).2 ∧ (GridQuadrature.sample L p).2 ≤ 1 := hp.2 have he := abs_le.mp (hη p) have hu := mul_nonneg hb.1.le hp1.1 have hv := mul_nonneg hb.2.2.1.le hp2.1 have hu1 := mul_le_mul hb.2.1 hp1.2 hp1.1 (by norm_num : (0 : ℝ) ≤ 1) have hv1 := mul_le_mul hb.2.2.2 hp2.2 hp2.1 (by norm_num : (0 : ℝ) ≤ 2) dsimp [EmpiricalPairKernel.center, ParameterKernel.projection] constructor <;> nlinarith lemma difference_eq_zero_of_notMem {L : ℕ} (hL : 0 < L) {δ h : ℝ} (hδ1 : δ < 1) (hh1 : h ≤ 1) {a : ℝ × ℝ} (ha : a ∈ rectangle δ) {η : GridPairs.Grid L → ℝ} (hη : ∀ p, |η p| ≤ 1) {t : ℝ} (ht : t ∉ Icc (-1 : ℝ) 5) : smoothed (center L δ η a) h t - density (1 - δ + a.1) (1 + a.2) t = 0 := by have hz : smoothed (center L δ η a) h t = 0 := by unfold smoothed have hz : ∀ p : GridPairs.Grid L, box h (t - center L δ η a p) = 0 := by intro p have hc := center_mem hL hδ1 ha hη p have hn : t - center L δ η a p ∉ Ico 0 h := by intro hm apply ht constructor <;> linarith [hc.1, hc.2, hm.1, hm.2] exact indicator_of_notMem hn _ simp [hz] have hb := parameter_bounds hδ1 ha have hd : density (1 - δ + a.1) (1 + a.2) t = 0 := by apply density_eq_zero_of_notMem intro hm apply ht constructor <;> linarith [hm.1, hm.2, hb.2.1, hb.2.2.2] rw [hz, hd, sub_self] lemma integrable_difference_sq {L : ℕ} {δ h : ℝ} (hδ1 : δ < 1) {a : ℝ × ℝ} (ha : a ∈ rectangle δ) (η : GridPairs.Grid L → ℝ) : Integrable (fun t => (smoothed (center L δ η a) h t - density (1 - δ + a.1) (1 + a.2) t)^2) := by have hb := parameter_bounds hδ1 ha apply (((integrable_smoothed_sq (center L δ η a) h).add (ContinuumEnergy.integrable_density_sq hb.1 hb.2.2.1)).const_mul 2).mono' · exact (((integrable_smoothed _ _).aestronglyMeasurable.sub (integrable_density _ _).aestronglyMeasurable).pow 2) · exact Filter.Eventually.of_forall fun t => by rw [Real.norm_eq_abs, abs_of_nonneg (sq_nonneg _)] change (smoothed (center L δ η a) h t - density (1 - δ + a.1) (1 + a.2) t)^2 ≤ 2 * ((smoothed (center L δ η a) h t)^2 + (density (1 - δ + a.1) (1 + a.2) t)^2) nlinarith [sq_nonneg (smoothed (center L δ η a) h t + density (1 - δ + a.1) (1 + a.2) t)] /-- Cauchy--Schwarz on the actual support interval, proved with genuine integrable terms. -/ lemma integral_abs_sq_le_six {f : ℝ → ℝ} (hf : Integrable f) (hf2 : Integrable (fun t => f t ^ 2)) (hs : ∀ t, t ∉ Icc (-1 : ℝ) 5 → f t = 0) : (∫ t, |f t|)^2 ≤ 6 * ∫ t, f t ^ 2 := by let A : ℝ := ∫ t, |f t| have hA : (∫ t in Icc (-1 : ℝ) 5, |f t|) = A := setIntegral_eq_integral_of_forall_compl_eq_zero fun t ht => by simp [hs t ht] have hE : (∫ t in Icc (-1 : ℝ) 5, f t ^ 2) = ∫ t, f t ^ 2 := setIntegral_eq_integral_of_forall_compl_eq_zero fun t ht => by simp [hs t ht] have hc : IntegrableOn (fun _ : ℝ => (A / 6)^2) (Icc (-1 : ℝ) 5) := integrableOn_const (by simp) have hsub : IntegrableOn (fun t => f t ^ 2 - (2 * (A / 6)) * |f t|) (Icc (-1 : ℝ) 5) := hf2.integrableOn.sub (hf.abs.integrableOn.const_mul _) have hi : (0 : ℝ) ≤ ∫ t in Icc (-1 : ℝ) 5, (|f t| - A / 6)^2 := integral_nonneg (fun t : ℝ => sq_nonneg (|f t| - A / 6)) have he : (fun t => (|f t| - A / 6)^2) = (fun t => f t ^ 2 - (2 * (A / 6)) * |f t| + (A / 6)^2) := by funext t nlinarith [sq_abs (f t)] rw [he, integral_add hsub hc, integral_sub hf2.integrableOn (hf.abs.integrableOn.const_mul _), integral_const_mul, hA, hE, setIntegral_const] at hi norm_num [Real.volume_real_Icc, smul_eq_mul] at hi dsimp [A] at hi ⊢ nlinarith lemma integral_difference_abs_le {L : ℕ} (hL : 0 < L) {δ h : ℝ} (hδ1 : δ < 1) (hh1 : h ≤ 1) {a : ℝ × ℝ} (ha : a ∈ rectangle δ) {η : GridPairs.Grid L → ℝ} (hη : ∀ p, |η p| ≤ 1) : (∫ t, |smoothed (center L δ η a) h t - density (1 - δ + a.1) (1 + a.2) t|) ≤ Real.sqrt (6 * MesoscopicProjection.squareError L δ h η a) := by apply Real.le_sqrt_of_sq_le exact integral_abs_sq_le_six ((integrable_smoothed _ _).sub (integrable_density _ _)) (integrable_difference_sq hδ1 ha η) (fun _ ht => difference_eq_zero_of_notMem hL hδ1 hh1 ha hη ht) /-- Summing translated errors costs their L¹ sum, without any disjointness assumption. -/ lemma integral_excess_compare {f g : J → ℝ → ℝ} (hf : ∀ j, Integrable (f j)) (hg : ∀ j, Integrable (g j)) (hf0 : ∀ j t, 0 ≤ f j t) (hg0 : ∀ j t, 0 ≤ g j t) : (∫ t, max 0 ((∑ j, f j t) - 1)) ≤ (∫ t, max 0 ((∑ j, g j t) - 1)) + ∑ j, ∫ t, |f j t - g j t| := by have hfi := integrable_finsetSum Finset.univ (fun j _ => hf j) have hgi := integrable_finsetSum Finset.univ (fun j _ => hg j) have hge := integrable_excess hgi (fun t => Finset.sum_nonneg fun j _ => hg0 j t) have hdiff : Integrable (fun t : ℝ => ∑ j, |f j t - g j t|) := integrable_finsetSum Finset.univ (fun j _ => ((hf j).sub (hg j)).abs) calc _ ≤ ∫ t, max 0 ((∑ j, g j t) - 1) + ∑ j, |f j t - g j t| := by apply integral_mono (integrable_excess hfi (fun t => Finset.sum_nonneg fun j _ => hf0 j t)) (hge.add hdiff) intro t change max 0 ((∑ j, f j t) - 1) ≤ max 0 ((∑ j, g j t) - 1) + ∑ j, |f j t - g j t| apply max_le · exact add_nonneg (le_max_left _ _) (Finset.sum_nonneg fun j _ => abs_nonneg _) · have hs : (∑ j, f j t) - ∑ j, g j t ≤ ∑ j, |f j t - g j t| := by rw [← Finset.sum_sub_distrib] exact Finset.sum_le_sum fun j _ => le_abs_self _ linarith [le_max_right (0 : ℝ) ((∑ j, g j t) - 1)] _ = _ := by calc _ = (∫ t, max 0 ((∑ j, g j t) - 1)) + ∫ t, ∑ j, |f j t - g j t| := integral_add hge hdiff _ = _ := congrArg ((∫ t, max 0 ((∑ j, g j t) - 1)) + ·) (integral_finsetSum Finset.univ (fun j _ => ((hf j).sub (hg j)).abs)) lemma sum_sqrt_le (E : J → ℝ) (hE : ∀ j, 0 ≤ E j) : (∑ j, Real.sqrt (6 * E j)) ≤ Real.sqrt (6 * (Fintype.card J : ℝ) * ∑ j, E j) := by apply Real.le_sqrt_of_sq_le have hsqrt (j : J) : Real.sqrt (6 * E j) ^ 2 = 6 * E j := Real.sq_sqrt (mul_nonneg (by norm_num) (hE j)) have hc := Finset.sum_mul_sq_le_sq_mul_sq Finset.univ (fun _ : J => (1 : ℝ)) (fun j => Real.sqrt (6 * E j)) simp only [one_mul, one_pow, Finset.sum_const, Finset.card_univ, nsmul_eq_mul, mul_one, hsqrt] at hc simp_rw [← Finset.mul_sum] at hc nlinarith [hc] /-- The finite-block intensity bound used before selecting common parameters. -/ theorem integral_aggregate_excess_le {L : ℕ} (hL : 0 < L) (D : J → ℤ) (hD : Function.Injective D) {δ h : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (hh : 0 < h) (hh1 : h ≤ 1) (η : J → GridPairs.Grid L → ℝ) (hη : ∀ j p, |η j p| ≤ 1) {a : ℝ × ℝ} (ha : a ∈ rectangle δ) : (∫ t, max 0 (aggregate D h (fun j => center L δ (η j) a) t - 1)) ≤ δ * (Fintype.card J : ℝ) + Real.sqrt (6 * (Fintype.card J : ℝ) * ∑ j, MesoscopicProjection.squareError L δ h (η j) a) := by have hb := parameter_bounds hδ1 ha have hc := integral_excess_compare (f := fun j t => smoothed (center L δ (η j) a) h (t - (D j : ℝ))) (g := fun j t => density (1 - δ + a.1) (1 + a.2) (t - (D j : ℝ))) (fun j => (integrable_smoothed _ _).comp_sub_right _) (fun j => (integrable_density _ _).comp_sub_right _) (fun j t => smoothed_nonneg _ hh _) (fun j t => density_nonneg hb.1 hb.2.2.1 _) change (∫ t, max 0 (aggregate D h (fun j => center L δ (η j) a) t - 1)) ≤ (∫ t, max 0 (reference D δ a t - 1)) + _ at hc refine hc.trans (add_le_add (integral_reference_excess_le D hD hδ hδ1 ha) ?_) calc _ ≤ ∑ j, Real.sqrt (6 * MesoscopicProjection.squareError L δ h (η j) a) := by apply Finset.sum_le_sum intro j hj rw [integral_sub_right_eq_self (fun t => |smoothed (center L δ (η j) a) h t - density (1 - δ + a.1) (1 + a.2) t|)] exact integral_difference_abs_le hL hδ1 hh1 ha (hη j) _ ≤ _ := sum_sqrt_le _ (fun j => MesoscopicProjection.squareError_nonneg _ _ _ _ _) /-- The final floor correction is pointwise in the parameter and can depend on it arbitrarily. -/ theorem integral_aggregate_excess_le_stable {L : ℕ} (hL : 0 < L) (D : J → ℤ) (hD : Function.Injective D) {δ h ν : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (hh : 0 < h) (hh1 : h ≤ 1) (η : J → GridPairs.Grid L → ℝ) (hη : ∀ j p, |η j p| ≤ 1) {a : ℝ × ℝ} (ha : a ∈ rectangle δ) (w : J → GridPairs.Grid L → ℝ) (hw : ∀ j p, |w j p - center L δ (η j) a p| ≤ ν) : (∫ t, max 0 (aggregate D h w t - 1)) ≤ δ * (Fintype.card J : ℝ) + Real.sqrt (6 * (Fintype.card J : ℝ) * ∑ j, MesoscopicProjection.squareError L δ h (η j) a) + 2 * (Fintype.card J : ℝ) * ν / h := by letI : Nonempty (GridPairs.Grid L) := ⟨(⟨0, hL⟩, ⟨0, hL⟩)⟩ have hc := integral_excess_compare (f := fun j t => smoothed (w j) h (t - (D j : ℝ))) (g := fun j t => smoothed (center L δ (η j) a) h (t - (D j : ℝ))) (fun j => (integrable_smoothed _ _).comp_sub_right _) (fun j => (integrable_smoothed _ _).comp_sub_right _) (fun j t => smoothed_nonneg _ hh _) (fun j t => smoothed_nonneg _ hh _) refine hc.trans (add_le_add (integral_aggregate_excess_le hL D hD hδ hδ1 hh hh1 η hη ha) ?_) calc _ ≤ ∑ _j : J, 2 * ν / h := by apply Finset.sum_le_sum intro j hj rw [integral_sub_right_eq_self (fun t => |smoothed (w j) h t - smoothed (center L δ (η j) a) h t|)] exact integral_smoothed_sub_abs_le _ _ hh (hw j) _ = _ := by simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul]; ring end DistanceCounts.AggregateDensity end end BodyFile090 -- Source: DistanceCounts/ProjectionScaling.lean section BodyFile091 /-! Exact scaling from integer-jitter unit cells to the normalized empirical densities. -/ noncomputable section namespace DistanceCounts.ProjectionScaling open Set MeasureTheory ProjectionDensity EmpiricalEnergy open scoped Classical variable {J I : Type*} [Fintype J] [Fintype I] theorem box_scaled {m : ℝ} (hm : 0 < m) (h x : ℝ) : box (m * h) (m * x) = m⁻¹ * box h x := by have h0 : 0 ≤ m * x ↔ 0 ≤ x := by simpa only [mul_zero] using (mul_le_mul_iff_right₀ hm (b := 0) (c := x)) have hi : m * x ∈ Ico 0 (m * h) ↔ x ∈ Ico 0 h := and_congr h0 (mul_lt_mul_iff_right₀ hm) by_cases hx : x ∈ Ico 0 h · simp only [box, Set.indicator_of_mem (hi.mpr hx), Set.indicator_of_mem hx, one_div, mul_inv_rev] ring · have hn : m * x ∉ Ico 0 (m * h) := fun hh => hx (hi.mp hh) simp only [box, Set.indicator_of_notMem hn, Set.indicator_of_notMem hx, mul_zero] theorem box_rescale {m : ℝ} (hm : 0 < m) (H t c : ℝ) : box H (t - c) = m⁻¹ * box (H / m) (t / m - c / m) := by have h := box_scaled hm (H / m) ((t - c) / m) have hH : m * (H / m) = H := by field_simp [hm.ne'] have hx : m * ((t - c) / m) = t - c := by field_simp [hm.ne'] rw [hH, hx, sub_div] at h exact h /-- The exact raw intensity of all integer outputs in the chosen groups. -/ def groupIntensity (H : ℕ) (Z : J → I → ℤ) (t : ℝ) : ℝ := ∑ j, ∑ i, box (H : ℝ) (t - ((Z j i - (H : ℤ) + 1 : ℤ) : ℝ)) def normalizedCenter (H : ℕ) (Z : J → I → ℤ) (j : J) (i : I) : ℝ := ((Z j i - (H : ℤ) + 1 : ℤ) : ℝ) / (Fintype.card I : ℝ) theorem groupIntensity_eq [Nonempty I] (H : ℕ) (Z : J → I → ℤ) (t : ℝ) : groupIntensity H Z t = ∑ j, smoothed (normalizedCenter H Z j) ((H : ℝ) / Fintype.card I) (t / (Fintype.card I : ℝ)) := by have hm : (0 : ℝ) < Fintype.card I := by exact_mod_cast Fintype.card_pos unfold groupIntensity smoothed normalizedCenter apply Finset.sum_congr rfl intro j _ rw [Finset.mul_sum] apply Finset.sum_congr rfl intro i _ exact box_rescale hm _ _ _ theorem integrable_groupIntensity (H : ℕ) (Z : J → I → ℤ) : Integrable (groupIntensity H Z) := by exact integrable_finsetSum Finset.univ fun j _ => integrable_finsetSum Finset.univ fun i _ => integrable_box_translate _ _ theorem groupIntensity_nonneg {H : ℕ} (hH : 0 < H) (Z : J → I → ℤ) (t : ℝ) : 0 ≤ groupIntensity H Z t := by exact Finset.sum_nonneg fun j _ => Finset.sum_nonneg fun i _ => box_nonneg (by exact_mod_cast hH) _ theorem integrable_groupIntensity_excess {H : ℕ} (hH : 0 < H) (Z : J → I → ℤ) : Integrable (fun t => max 0 (groupIntensity H Z t - 1)) := AggregateDensity.integrable_excess (integrable_groupIntensity H Z) (groupIntensity_nonneg hH Z) theorem intensity_eq_groupIntensity {M H : ℕ} (e : Fin M ≃ J × I) (Y : Fin M → ℤ) (t : ℝ) : CountIntensity.intensity H Y t = groupIntensity H (fun j i => Y (e.symm (j, i))) t := by unfold CountIntensity.intensity groupIntensity calc _ = ∑ p : J × I, box (H : ℝ) (t - ((Y (e.symm p) - (H : ℤ) + 1 : ℤ) : ℝ)) := Fintype.sum_equiv e _ _ (fun i => by simp only [e.symm_apply_apply]) _ = _ := Fintype.sum_prod_type _ theorem integral_groupIntensity_excess [Nonempty I] (H : ℕ) (Z : J → I → ℤ) : (∫ t, max 0 (groupIntensity H Z t - 1)) = (Fintype.card I : ℝ) * ∫ t, max 0 ((∑ j, smoothed (normalizedCenter H Z j) ((H : ℝ) / Fintype.card I) t) - 1) := by simp_rw [groupIntensity_eq H Z] have h := Measure.integral_comp_div (fun t : ℝ => max 0 ((∑ j, smoothed (normalizedCenter H Z j) ((H : ℝ) / Fintype.card I) t) - 1)) (Fintype.card I : ℝ) simpa only [abs_of_nonneg (show (0 : ℝ) ≤ Fintype.card I by positivity), smul_eq_mul] using h theorem smoothed_shift (z : I → ℝ) (h c t : ℝ) : smoothed z h t = smoothed (fun i => z i - c) h (t - c) := by unfold smoothed congr 1 apply Finset.sum_congr rfl intro i _ congr 1 ring theorem integral_groupIntensity_excess_degrees {L H : ℕ} [Nonempty (GridPairs.Grid L)] (D : J → ℤ) (Z : J → GridPairs.Grid L → ℤ) : (∫ t, max 0 (groupIntensity H Z t - 1)) = ((L : ℝ) ^ 2) * ∫ t, max 0 (AggregateDensity.aggregate D ((H : ℝ) / (L : ℝ) ^ 2) (fun j i => normalizedCenter H Z j i - (D j : ℝ)) t - 1) := by rw [integral_groupIntensity_excess H Z] simp only [GridPairs.Grid, Fintype.card_prod, Fintype.card_fin, Nat.cast_mul] simp only [← pow_two] change (L : ℝ) ^ 2 * _ = (L : ℝ) ^ 2 * _ congr 1 apply integral_congr_ae apply ae_of_all intro t have hs : (∑ j, smoothed (normalizedCenter H Z j) ((H : ℝ) / (L : ℝ) ^ 2) t) = AggregateDensity.aggregate D ((H : ℝ) / (L : ℝ) ^ 2) (fun j i => normalizedCenter H Z j i - (D j : ℝ)) t := by unfold AggregateDensity.aggregate apply Finset.sum_congr rfl intro j _ exact smoothed_shift _ _ _ _ exact congrArg (fun x : ℝ => max 0 (x - 1)) hs /-- Normalization keeps the integer unit-cell shift and the common degree exactly. -/ theorem normalized_error {L : ℕ} (hL : 0 < L) (Z : ℤ) (D e α β H E : ℝ) (x y : Fin L) (he : |(Z : ℝ) - (D * (L : ℝ) ^ 2 + e + α * L * x + β * L * y)| ≤ E) : |((Z : ℝ) - H + 1) / (L : ℝ) ^ 2 - D - (α * ((x : ℝ) / L) + β * ((y : ℝ) / L) + (e / (L : ℝ) ^ 2 - H / (L : ℝ) ^ 2 + 1 / (L : ℝ) ^ 2))| ≤ E / (L : ℝ) ^ 2 := by have hLr : (0 : ℝ) < L := by exact_mod_cast hL have hid : ((Z : ℝ) - H + 1) / (L : ℝ) ^ 2 - D - (α * ((x : ℝ) / L) + β * ((y : ℝ) / L) + (e / (L : ℝ) ^ 2 - H / (L : ℝ) ^ 2 + 1 / (L : ℝ) ^ 2)) = ((Z : ℝ) - (D * (L : ℝ) ^ 2 + e + α * L * x + β * L * y)) / (L : ℝ) ^ 2 := by field_simp [hLr.ne'] <;> ring rw [hid, abs_div, abs_of_nonneg (sq_nonneg (L : ℝ))] exact div_le_div_of_nonneg_right he (sq_nonneg (L : ℝ)) end DistanceCounts.ProjectionScaling end end BodyFile091 -- Source: DistanceCounts/JitterSelection.lean section BodyFile092 /-! Selection of actual finite group jitters by the second-moment method. -/ noncomputable section open MeasureTheory ProbabilityTheory open scoped BigOperators namespace DistanceCounts.JitterSelection /-- The coordinates of the finite product of uniform jitter laws are independent, including after conversion to integer shifts. -/ theorem uniform_group_independent {G : Type*} [Fintype G] {H : ℕ} [Nonempty (Fin H)] [MeasurableSpace (Fin H)] [MeasurableSingletonClass (Fin H)] : iIndepFun (fun a (q : G → Fin H) => ((q a).val : ℤ)) (Measure.pi (fun _ : G => (PMF.uniformOfFintype (Fin H)).toMeasure)) := by exact iIndepFun_pi (fun _ => (measurable_of_countable (fun r : Fin H => (r.val : ℤ))).aemeasurable) /-- The occupancy mean under the actual finite product law is the discrete jitter mean, not a continuous-uniform approximation. -/ theorem uniform_occupancy_mean {M : ℕ} {G : Type*} [Fintype G] {H : ℕ} [Nonempty (Fin H)] [MeasurableSpace (Fin H)] [MeasurableSingletonClass (Fin H)] (Z : Fin M → ℤ) (g : Fin M → G) (B j : ℤ) : (∫ q : G → Fin H, JitterVariance.occupancy (JitterVariance.jitterBin Z g (fun a q => ((q a).val : ℤ)) B) j q ∂Measure.pi (fun _ : G => (PMF.uniformOfFintype (Fin H)).toMeasure)) = CountIntensity.jitterMean H Z B j := by classical let ν : Measure (Fin H) := (PMF.uniformOfFintype (Fin H)).toMeasure let μ : Measure (G → Fin H) := Measure.pi (fun _ : G => ν) have hpin (i : Fin M) : (∫ q : G → Fin H, JitterVariance.binIndicator (JitterVariance.jitterBin Z g (fun a q => ((q a).val : ℤ)) B i) j q ∂μ) = (H : ℝ)⁻¹ * ((Finset.univ.filter (fun r : Fin H => (Z i - (r.val : ℤ)) / B = j)).card : ℝ) := by let f : Fin H → ℝ := fun r => if (Z i - (r.val : ℤ)) / B = j then 1 else 0 change (∫ q : G → Fin H, f (q (g i)) ∂μ) = _ have hmap := (measurePreserving_eval (fun _ : G => ν) (g i)).map_eq calc (∫ q : G → Fin H, f (q (g i)) ∂μ) = ∫ r, f r ∂Measure.map (Function.eval (g i)) μ := (integral_map (measurable_pi_apply (g i)).aemeasurable (measurable_of_countable f).aestronglyMeasurable).symm _ = ∫ r, f r ∂ν := by rw [hmap] _ = (H : ℝ)⁻¹ * ((Finset.univ.filter (fun r : Fin H => (Z i - (r.val : ℤ)) / B = j)).card : ℝ) := by simp only [ν, PMF.integral_eq_sum, PMF.uniformOfFintype_apply, Fintype.card_fin, ENNReal.toReal_inv, ENNReal.toReal_natCast, smul_eq_mul, ← Finset.mul_sum] congr 1 simp [f, Finset.sum_boole] change (∫ q, ∑ i : Fin M, JitterVariance.binIndicator (JitterVariance.jitterBin Z g (fun a q => ((q a).val : ℤ)) B i) j q ∂μ) = _ rw [integral_finsetSum Finset.univ (fun _ _ => Integrable.of_finite)] simp_rw [hpin] exact (Finset.mul_sum Finset.univ _ _).symm /-- Positive-part Lipschitz control and finite Cauchy--Schwarz turn one simultaneous squared-error bound into an overflow bound. -/ theorem overflow_le_of_sq_error {ι : Type*} (J : Finset ι) (x m : ι → ℝ) (b V : ℝ) (hV : (∑ j ∈ J, (x j - m j) ^ 2) ≤ V) : (∑ j ∈ J, max 0 (x j - b)) ≤ (∑ j ∈ J, max 0 (m j - b)) + Real.sqrt ((J.card : ℝ) * V) := by have hpos (j : ι) : max 0 (x j - b) ≤ max 0 (m j - b) + |x j - m j| := by apply max_le · exact add_nonneg (le_max_left _ _) (abs_nonneg _) · have hm := le_max_right (0 : ℝ) (m j - b) have hx := le_abs_self (x j - m j) linarith have hcs : (∑ j ∈ J, |x j - m j|) ^ 2 ≤ (J.card : ℝ) * ∑ j ∈ J, (x j - m j) ^ 2 := by simpa only [one_mul, one_pow, Finset.sum_const, nsmul_eq_mul, mul_one, sq_abs] using Finset.sum_mul_sq_le_sq_mul_sq J (fun _ => (1 : ℝ)) (fun j => |x j - m j|) have herr : (∑ j ∈ J, |x j - m j|) ≤ Real.sqrt ((J.card : ℝ) * V) := Real.le_sqrt_of_sq_le (hcs.trans (mul_le_mul_of_nonneg_left hV (Nat.cast_nonneg _))) calc (∑ j ∈ J, max 0 (x j - b)) ≤ ∑ j ∈ J, (max 0 (m j - b) + |x j - m j|) := Finset.sum_le_sum fun j _ => hpos j _ = (∑ j ∈ J, max 0 (m j - b)) + ∑ j ∈ J, |x j - m j| := Finset.sum_add_distrib _ ≤ _ := by linarith /-- An actual choice of one integer jitter per group achieves the overflow bound. The sample space is the finite function space `G → Fin H`, endowed in the proof with the product of uniform probability laws. No pins are discarded. -/ theorem exists_jitter_overflow {M : ℕ} {G : Type*} [Fintype G] [DecidableEq G] (H : ℕ) (hH : 0 < H) (Z : Fin M → ℤ) (g : Fin M → G) (B : ℤ) (hB : 0 < B) (J : Finset ℤ) : ∃ q : G → Fin H, (∑ j ∈ J, max 0 ((CountIntensity.binCount (fun i => Z i - ((q (g i)).val : ℤ)) B j : ℝ) - (B : ℝ))) ≤ (∑ j ∈ J, max 0 (CountIntensity.jitterMean H Z B j - (B : ℝ))) + Real.sqrt ((J.card : ℝ) * ((M : ℝ) + 2 * ((Finset.univ.filter (fun p : Fin M × Fin M => p.1 < p.2 ∧ g p.1 = g p.2 ∧ |Z p.1 - Z p.2| < B)).card : ℝ))) := by classical letI : Nonempty (Fin H) := ⟨⟨0, hH⟩⟩ letI : MeasurableSpace (Fin H) := ⊤ letI : MeasurableSingletonClass (Fin H) := ⟨fun _ => trivial⟩ let ν : Measure (Fin H) := (PMF.uniformOfFintype (Fin H)).toMeasure let μ : Measure (G → Fin H) := Measure.pi (fun _ : G => ν) let shifts : G → (G → Fin H) → ℤ := fun a q => ((q a).val : ℤ) let W := JitterVariance.jitterBin Z g shifts B let X := JitterVariance.occupancy W have hshift (a : G) : Measurable (shifts a) := (measurable_of_countable (fun r : Fin H => (r.val : ℤ))).comp (measurable_pi_apply a) have hind : iIndepFun shifts μ := uniform_group_independent have hW (i : Fin M) : Measurable (W i) := (measurable_of_countable (fun z : ℤ => (Z i - z) / B)).comp (hshift (g i)) have hmean (j : ℤ) : (∫ q, X j q ∂μ) = CountIntensity.jitterMean H Z B j := uniform_occupancy_mean Z g B j have hvar := JitterVariance.jitter_variance_bound_unordered (μ := μ) Z g shifts hshift hind B hB J let E : (G → Fin H) → ℝ := fun q => ∑ j ∈ J, (X j q - CountIntensity.jitterMean H Z B j) ^ 2 have hE : (∫ q, E q ∂μ) = ∑ j ∈ J, variance (X j) μ := by rw [show (∫ q, E q ∂μ) = ∑ j ∈ J, ∫ q, (X j q - CountIntensity.jitterMean H Z B j) ^ 2 ∂μ from integral_finsetSum J (fun _ _ => Integrable.of_finite)] apply Finset.sum_congr rfl intro j _ rw [variance_eq_integral (JitterVariance.occupancy_memLp hW j).aestronglyMeasurable.aemeasurable, hmean] obtain ⟨q, hq⟩ := exists_le_integral (μ := μ) (f := E) Integrable.of_finite rw [hE] at hq have hchoice := overflow_le_of_sq_error J (fun j => X j q) (CountIntensity.jitterMean H Z B) (B : ℝ) _ (hq.trans hvar) have hX (j : ℤ) : X j q = (CountIntensity.binCount (fun i => Z i - ((q (g i)).val : ℤ)) B j : ℝ) := by simp only [CountIntensity.binCount_cast, X, W, shifts, JitterVariance.occupancy, JitterVariance.binIndicator, JitterVariance.jitterBin] apply Finset.sum_congr rfl intro i _ by_cases hij : (Z i - ((q (g i)).val : ℤ)) / B = j <;> simp only [hij, ite_true, ite_false] refine ⟨q, ?_⟩ simpa only [hX] using hchoice end DistanceCounts.JitterSelection end end BodyFile092 -- Source: DistanceCounts/Binning.lean section BodyFile093 /-! Exact capacity selection, integer bin targets, and bounded count corrections. -/ noncomputable section open scoped BigOperators namespace DistanceCounts /-- Retain a maximal capacity-limited selection in every occupied bin. The loss is exactly the sum of the excesses, not merely bounded by it. -/ theorem exists_bin_selection {α β : Type*} [DecidableEq β] (I : Finset α) (bin : α → β) (B : ℕ) : ∃ S : Finset α, S ⊆ I ∧ (∀ j, (S.filter (fun i => bin i = j)).card = min B (I.filter (fun i => bin i = j)).card) ∧ S.card + ∑ j ∈ I.image bin, ((I.filter (fun i => bin i = j)).card - B) = I.card := by classical have hex (j : β) : ∃ A : Finset α, A ⊆ I.filter (fun i => bin i = j) ∧ A.card = min B (I.filter (fun i => bin i = j)).card := Finset.exists_subset_card_eq (Nat.min_le_right _ _) choose A hsub hcard using hex let S := (I.image bin).biUnion A have hSI : S ⊆ I := by intro i hi obtain ⟨j, hj, hij⟩ := Finset.mem_biUnion.mp hi exact (Finset.mem_filter.mp (hsub j hij)).1 have hfiber (j : β) : S.filter (fun i => bin i = j) = A j := by ext i constructor · intro hi obtain ⟨hiS, hij⟩ := Finset.mem_filter.mp hi obtain ⟨k, hk, hik⟩ := Finset.mem_biUnion.mp hiS have hik' := (Finset.mem_filter.mp (hsub k hik)).2 have hkj : k = j := hik'.symm.trans hij simpa only [hkj] using hik · intro hi obtain ⟨hiI, hij⟩ := Finset.mem_filter.mp (hsub j hi) apply Finset.mem_filter.mpr refine ⟨Finset.mem_biUnion.mpr ⟨j, ?_, hi⟩, hij⟩ exact Finset.mem_image.mpr ⟨i, hiI, hij⟩ refine ⟨S, hSI, fun j => (congrArg Finset.card (hfiber j)).trans (hcard j), ?_⟩ have hcountS : S.card = ∑ j ∈ I.image bin, (A j).card := by calc S.card = ∑ j ∈ I.image bin, (S.filter (fun i => bin i = j)).card := Finset.card_eq_sum_card_fiberwise (fun i hi => Finset.mem_image_of_mem bin (hSI hi)) _ = ∑ j ∈ I.image bin, (A j).card := by simp only [hfiber] rw [hcountS, ← Finset.sum_add_distrib, Finset.card_eq_sum_card_image bin I] apply Finset.sum_congr rfl intro j hj rw [hcard] omega /-- Integer bins, including negative bin indices. -/ def InCountBin (B : ℕ) (j y : ℤ) : Prop := j * (B : ℤ) ≤ y ∧ y < (j + 1) * (B : ℤ) lemma countBin_unique {B : ℕ} (hB : 0 < B) {j k y : ℤ} (hj : InCountBin B j y) (hk : InCountBin B k y) : j = k := by have hB' : (0 : ℤ) < B := by exact_mod_cast hB rcases hj with ⟨hjl, hju⟩ rcases hk with ⟨hkl, hku⟩ by_contra hne rcases lt_or_gt_of_ne hne with h | h · have hstep : j + 1 ≤ k := by omega have := mul_le_mul_of_nonneg_right hstep hB'.le omega · have hstep : k + 1 ≤ j := by omega have := mul_le_mul_of_nonneg_right hstep hB'.le omega /-- Capacity is sufficient to assign genuinely distinct integer targets in each bin. -/ theorem exists_distinct_bin_targets {α : Type*} (S : Finset α) (bin : α → ℤ) (B : ℕ) (hB : 0 < B) (hcap : ∀ j, (S.filter (fun i => bin i = j)).card ≤ B) : ∃ T : {i // i ∈ S} → ℤ, Function.Injective T ∧ ∀ i, InCountBin B (bin i.val) (T i) := by classical let F (j : ℤ) := {i // i ∈ S.filter (fun i => bin i = j)} have hemb (j : ℤ) : ∃ f : F j → Fin B, Function.Injective f := by have hj : Fintype.card (F j) ≤ B := by simpa only [F, Fintype.card_coe] using hcap j refine ⟨fun i => Fin.castLE hj (Fintype.equivFin (F j) i), ?_⟩ intro i k hik apply (Fintype.equivFin (F j)).injective apply Fin.ext exact congrArg (fun z : Fin B => z.val) hik choose f hf using hemb let rank (i : {i // i ∈ S}) : Fin B := f (bin i.val) ⟨i.val, Finset.mem_filter.mpr ⟨i.property, rfl⟩⟩ let T (i : {i // i ∈ S}) : ℤ := bin i.val * (B : ℤ) + (rank i).val have hT (i : {i // i ∈ S}) : InCountBin B (bin i.val) (T i) := by have hr : ((rank i).val : ℤ) < B := by exact_mod_cast (rank i).isLt have hn : (0 : ℤ) ≤ (rank i).val := by omega dsimp [T, InCountBin] constructor <;> nlinarith refine ⟨T, ?_, hT⟩ intro i k hik have hbin : bin i.val = bin k.val := countBin_unique hB (hT i) (hik.symm ▸ hT k) have hrank : rank i = rank k := by apply Fin.ext dsimp [T] at hik rw [hbin] at hik exact_mod_cast (add_left_cancel hik) have hval : i.val = k.val := by have hSigmaInj : Function.Injective (fun w : Σ j : ℤ, F j => (⟨w.1, f w.1 w.2⟩ : Σ _ : ℤ, Fin B)) := by rintro ⟨j, a⟩ ⟨l, b⟩ hab have hjl : j = l := congrArg Sigma.fst hab subst l have hfhab : f j a = f j b := congrArg (fun w : Σ _ : ℤ, Fin B => w.2) hab exact congrArg (Sigma.mk j) (hf j hfhab) have hpair : (⟨bin i.val, rank i⟩ : Σ _ : ℤ, Fin B) = ⟨bin k.val, rank k⟩ := Sigma.ext hbin (heq_of_eq hrank) have hinput : (⟨bin i.val, ⟨i.val, Finset.mem_filter.mpr ⟨i.property, rfl⟩⟩⟩ : Σ j : ℤ, F j) = ⟨bin k.val, ⟨k.val, Finset.mem_filter.mpr ⟨k.property, rfl⟩⟩⟩ := hSigmaInj hpair exact congrArg (fun w : Σ j : ℤ, F j => w.2.val) hinput exact Subtype.ext hval /-- The exact correction is positive and fits the bounded unary dictionary. -/ theorem bin_correction_bounds {B : ℕ} {j Y T : ℤ} (hY : InCountBin B j Y) (hT : InCountBin B j T) : 1 ≤ Y - T + (B : ℤ) ∧ Y - T + (B : ℤ) ≤ 2 * (B : ℤ) - 1 := by rcases hY with ⟨hYl, hYu⟩ rcases hT with ⟨hTl, hTu⟩ constructor <;> nlinarith /-- A common control-count shift preserves all target distinctions. -/ theorem corrected_counts_injective {α : Type*} (Y T : α → ℤ) (hT : Function.Injective T) (B C : ℤ) : Function.Injective (fun i => Y i + C - (Y i - T i + B)) := by intro i j hij apply hT linarith lemma corrected_count_eq (Y T B C : ℤ) : Y + C - (Y - T + B) = T + (C - B) := by ring /-- Distinct corrected counts give exactly as many count values as selected pins. -/ theorem card_corrected_counts {α : Type*} (S : Finset α) (Y T : α → ℤ) (hT : Set.InjOn T S) (B C : ℤ) : (S.image (fun i => Y i + C - (Y i - T i + B))).card = S.card := by classical apply Finset.card_image_of_injOn intro i hi j hj hij apply hT hi hj linarith end DistanceCounts end end BodyFile093 -- Source: DistanceCounts/FiniteBinWindow.lean section BodyFile094 /-! Finite support of actual integer bins and capacity-limited witness selection. The ambient index set and its geometric points are never changed. -/ noncomputable section open scoped BigOperators namespace DistanceCounts.FiniteBinWindow /-- A finite window of Euclidean integer quotients, including negative levels. -/ def window (lo hi B : ℤ) : Finset ℤ := Finset.Icc (lo / B) (hi / B) /-- Euclidean remainder bounds locate every integer in its actual bin. -/ theorem ediv_bounds (y : ℤ) {B : ℤ} (hB : 0 < B) : y / B * B ≤ y ∧ y < (y / B + 1) * B := by have heq := Int.emod_add_mul_ediv y B have hlo := Int.emod_nonneg y hB.ne' have hhi := Int.emod_lt_of_pos y hB constructor <;> nlinarith /-- Monotonicity here uses Euclidean division, not truncation toward zero. -/ theorem ediv_mono {x y B : ℤ} (hB : 0 < B) (hxy : x ≤ y) : x / B ≤ y / B := by have hx := ediv_bounds x hB have hy := ediv_bounds y hB by_contra h have hstep : y / B + 1 ≤ x / B := by omega have hmul := mul_le_mul_of_nonneg_right hstep hB.le nlinarith [hx.1, hy.2] theorem mem_window {lo hi B y : ℤ} (hB : 0 < B) (hy : lo ≤ y ∧ y ≤ hi) : y / B ∈ window lo hi B := by exact Finset.mem_Icc.mpr ⟨ediv_mono hB hy.1, ediv_mono hB hy.2⟩ /-- At most the range length divided by the bin width, plus two endpoint bins. -/ theorem card_window_le {lo hi B : ℤ} (hlo : lo ≤ hi) (hB : 0 < B) : ((window lo hi B).card : ℝ) ≤ ((hi : ℝ) - (lo : ℝ)) / (B : ℝ) + 2 := by have hquot := ediv_mono hB hlo have hcard : ((window lo hi B).card : ℤ) = hi / B + 1 - lo / B := Int.card_Icc_of_le _ _ (by omega) have hcardR : ((window lo hi B).card : ℝ) = ((hi / B : ℤ) : ℝ) + 1 - ((lo / B : ℤ) : ℝ) := by exact_mod_cast hcard have hloR : (lo : ℝ) < (((lo / B : ℤ) : ℝ) + 1) * (B : ℝ) := by exact_mod_cast (ediv_bounds lo hB).2 have hhiR : ((hi / B : ℤ) : ℝ) * (B : ℝ) ≤ (hi : ℝ) := by exact_mod_cast (ediv_bounds hi hB).1 have hBR : (0 : ℝ) < B := by exact_mod_cast hB have hbound : ((window lo hi B).card : ℝ) - 2 ≤ ((hi : ℝ) - (lo : ℝ)) / (B : ℝ) := by apply (le_div_iff₀ hBR).2 nlinarith linarith /-- The actual occupied bins are a subset of the finite endpoint window. -/ theorem image_subset_window {M : ℕ} (Y : Fin M → ℤ) {lo hi B : ℤ} (hB : 0 < B) (hY : ∀ i, lo ≤ Y i ∧ Y i ≤ hi) : Finset.univ.image (fun i => Y i / B) ⊆ window lo hi B := by intro j hj obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp hj exact mem_window hB (hY i) /-- There is no occupancy outside the proved finite support. -/ theorem binCount_eq_zero_of_not_mem {M : ℕ} (Y : Fin M → ℤ) (B : ℤ) (J : Finset ℤ) (hsupport : ∀ i, Y i / B ∈ J) {j : ℤ} (hj : j ∉ J) : CountIntensity.binCount Y B j = 0 := by classical apply Finset.card_eq_zero.mpr apply Finset.eq_empty_iff_forall_notMem.mpr intro i hi have heq := (Finset.mem_filter.mp hi).2 exact hj (heq ▸ hsupport i) /-- A group jitter in `Fin H` lowers an integer level by at most `H - 1`. -/ theorem jitter_range {M H : ℕ} {G : Type*} (Z : Fin M → ℤ) (g : Fin M → G) (q : G → Fin H) {lo hi : ℤ} (hZ : ∀ i, lo ≤ Z i ∧ Z i ≤ hi) (i : Fin M) : lo - ((H : ℤ) - 1) ≤ Z i - ((q (g i)).val : ℤ) ∧ Z i - ((q (g i)).val : ℤ) ≤ hi := by have hq : ((q (g i)).val : ℤ) < (H : ℤ) := by exact_mod_cast (q (g i)).isLt have hq0 : (0 : ℤ) ≤ (q (g i)).val := by positivity have hz := hZ i omega /-- All actual jitter outcomes have the same deterministic finite bin support. -/ theorem jitter_support {M H : ℕ} {G : Type*} (Z : Fin M → ℤ) (g : Fin M → G) (q : G → Fin H) {lo hi B : ℤ} (hB : 0 < B) (hZ : ∀ i, lo ≤ Z i ∧ Z i ≤ hi) : ∀ i, (Z i - ((q (g i)).val : ℤ)) / B ∈ window (lo - ((H : ℤ) - 1)) hi B := by intro i exact mem_window hB (jitter_range Z g q hZ i) /-- The jitter window grows by the actual maximal shift `H - 1`. -/ theorem card_jitter_window_le {H : ℕ} (hH : 0 < H) {lo hi B : ℤ} (hlo : lo ≤ hi) (hB : 0 < B) : ((window (lo - ((H : ℤ) - 1)) hi B).card : ℝ) ≤ ((hi : ℝ) - (lo : ℝ) + (H : ℝ) - 1) / (B : ℝ) + 2 := by have hH' : (0 : ℤ) < H := by exact_mod_cast hH have h := card_window_le (lo := lo - ((H : ℤ) - 1)) (hi := hi) (by omega) hB convert h using 1 <;> push_cast <;> ring private theorem cast_excess (n B : ℕ) : ((n - B : ℕ) : ℝ) = max 0 ((n : ℝ) - (B : ℝ)) := by by_cases h : B ≤ n · have hR : (B : ℝ) ≤ n := by exact_mod_cast h rw [Nat.cast_sub h, max_eq_right (sub_nonneg.mpr hR)] · have h' : n ≤ B := by omega have hR : (n : ℝ) ≤ B := by exact_mod_cast h' rw [Nat.sub_eq_zero_of_le h', Nat.cast_zero, max_eq_left (sub_nonpos.mpr hR)] /-- Select witnesses, not geometric points, using the existing exact bin selection. The finite support makes the loss exactly the overflow summed over `J`. -/ theorem exists_supported_selection {M : ℕ} (Y : Fin M → ℤ) (B : ℕ) (J : Finset ℤ) (hsupport : ∀ i, Y i / (B : ℤ) ∈ J) : ∃ S : Finset (Fin M), S ⊆ Finset.univ ∧ (∀ j, (S.filter (fun i => Y i / (B : ℤ) = j)).card = min B (CountIntensity.binCount Y (B : ℤ) j)) ∧ (M : ℝ) - (S.card : ℝ) = ∑ j ∈ J, max 0 ((CountIntensity.binCount Y (B : ℤ) j : ℝ) - (B : ℝ)) := by classical obtain ⟨S, hS, hcount, hloss⟩ := exists_bin_selection Finset.univ (fun i => Y i / (B : ℤ)) B have hsub : Finset.univ.image (fun i => Y i / (B : ℤ)) ⊆ J := by intro j hj obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp hj exact hsupport i have hsum : (∑ j ∈ Finset.univ.image (fun i => Y i / (B : ℤ)), (CountIntensity.binCount Y (B : ℤ) j - B)) = ∑ j ∈ J, (CountIntensity.binCount Y (B : ℤ) j - B) := by apply Finset.sum_subset hsub intro j _ hj have hzero : CountIntensity.binCount Y (B : ℤ) j = 0 := binCount_eq_zero_of_not_mem Y (B : ℤ) (Finset.univ.image (fun i => Y i / (B : ℤ))) (fun i => Finset.mem_image_of_mem _ (Finset.mem_univ i)) hj simp only [hzero, Nat.zero_sub] change S.card + (∑ j ∈ Finset.univ.image (fun i => Y i / (B : ℤ)), (CountIntensity.binCount Y (B : ℤ) j - B)) = Finset.univ.card at hloss rw [hsum, Finset.card_univ, Fintype.card_fin] at hloss have hreal := congrArg (fun n : ℕ => (n : ℝ)) hloss simp only [Nat.cast_add, Nat.cast_sum, cast_excess] at hreal refine ⟨S, hS, hcount, ?_⟩ linarith /-- The endpoint hypotheses themselves supply the support needed for exact selection. -/ theorem exists_window_selection {M : ℕ} (Y : Fin M → ℤ) (B : ℕ) (hB : 0 < B) {lo hi : ℤ} (hY : ∀ i, lo ≤ Y i ∧ Y i ≤ hi) : ∃ S : Finset (Fin M), S ⊆ Finset.univ ∧ (∀ j, (S.filter (fun i => Y i / (B : ℤ) = j)).card = min B (CountIntensity.binCount Y (B : ℤ) j)) ∧ (M : ℝ) - (S.card : ℝ) = ∑ j ∈ window lo hi (B : ℤ), max 0 ((CountIntensity.binCount Y (B : ℤ) j : ℝ) - (B : ℝ)) := by apply exists_supported_selection intro i exact mem_window (by exact_mod_cast hB) (hY i) /-- Actual injective targets give positive bounded integer corrections on the selected witnesses and exactly zero correction on every other original index. -/ theorem exists_selected_corrections {M : ℕ} (Y : Fin M → ℤ) (S : Finset (Fin M)) (B : ℕ) (hB : 0 < B) (hcap : ∀ j, (S.filter (fun i => Y i / (B : ℤ) = j)).card ≤ B) : ∃ q : Fin M → ℤ, (∀ i ∈ S, 1 ≤ q i ∧ q i ≤ 2 * (B : ℤ) - 1) ∧ (∀ i, i ∉ S → q i = 0) ∧ Set.InjOn (fun i => Y i - q i) S ∧ (S.image (fun i => Y i - q i)).card = S.card := by classical obtain ⟨T, hT, hbin⟩ := exists_distinct_bin_targets S (fun i => Y i / (B : ℤ)) B hB hcap let q : Fin M → ℤ := fun i => if hi : i ∈ S then Y i - T ⟨i, hi⟩ + (B : ℤ) else 0 have hq (i : Fin M) (hi : i ∈ S) : q i = Y i - T ⟨i, hi⟩ + (B : ℤ) := by simp only [q, dif_pos hi] have hinj : Set.InjOn (fun i => Y i - q i) S := by intro i hi k hk heq have htarget : T ⟨i, hi⟩ = T ⟨k, hk⟩ := by change Y i - q i = Y k - q k at heq rw [hq i hi, hq k hk] at heq linarith exact congrArg Subtype.val (hT htarget) refine ⟨q, ?_, ?_, hinj, Finset.card_image_of_injOn hinj⟩ · intro i hi rw [hq i hi] exact bin_correction_bounds (ediv_bounds (Y i) (by exact_mod_cast hB)) (hbin ⟨i, hi⟩) · intro i hi simp only [q, dif_neg hi] /-- End-to-end finite witness selection: the capacity, exact loss, and genuinely distinct corrected levels are conclusions, while all original indices remain. -/ theorem exists_supported_witnesses {M : ℕ} (Y : Fin M → ℤ) (B : ℕ) (hB : 0 < B) (J : Finset ℤ) (hsupport : ∀ i, Y i / (B : ℤ) ∈ J) : ∃ (S : Finset (Fin M)) (q : Fin M → ℤ), S ⊆ Finset.univ ∧ (∀ j, (S.filter (fun i => Y i / (B : ℤ) = j)).card ≤ B) ∧ (M : ℝ) - (S.card : ℝ) = (∑ j ∈ J, max 0 ((CountIntensity.binCount Y (B : ℤ) j : ℝ) - (B : ℝ))) ∧ (∀ i ∈ S, 1 ≤ q i ∧ q i ≤ 2 * (B : ℤ) - 1) ∧ (∀ i, i ∉ S → q i = 0) ∧ Set.InjOn (fun i => Y i - q i) S ∧ (S.image (fun i => Y i - q i)).card = S.card := by obtain ⟨S, hS, hcount, hloss⟩ := exists_supported_selection Y B J hsupport have hcap : ∀ j, (S.filter (fun i => Y i / (B : ℤ) = j)).card ≤ B := by intro j rw [hcount j] exact Nat.min_le_left _ _ obtain ⟨q, hq, hzero, hinj, hcard⟩ := exists_selected_corrections Y S B hB hcap exact ⟨S, q, hS, hcap, hloss, hq, hzero, hinj, hcard⟩ end DistanceCounts.FiniteBinWindow end end BodyFile094 -- Source: DistanceCounts/FineFixedCorrection.lean section BodyFile095 /-! Actual fixed-parameter jitters and unary corrections on the unchanged ambient pins. -/ noncomputable section open MeasureTheory open scoped BigOperators Classical namespace DistanceCounts.FineFixedCorrection /-- A deterministic window containing every possible row-jittered score. -/ def binWindow (K L B : ℕ) : Finset ℤ := FiniteBinWindow.window (-3 * (L : ℤ) ^ 2) (((K : ℤ) + 5) * (L : ℤ) ^ 2) B theorem card_binWindow_le (K L : ℕ) {B : ℕ} (hB : 0 < B) : ((binWindow K L B).card : ℝ) ≤ ((K : ℝ) + 8) * (L : ℝ) ^ 2 / B + 2 := by have hlo : -3 * (L : ℤ) ^ 2 ≤ ((K : ℤ) + 5) * (L : ℤ) ^ 2 := by have hp : 0 ≤ ((K : ℤ) + 8) * (L : ℤ) ^ 2 := by positivity nlinarith have h := FiniteBinWindow.card_window_le hlo (show (0 : ℤ) < B by exact_mod_cast hB) change ((binWindow K L B).card : ℝ) ≤ _ at h convert h using 1 <;> push_cast <;> ring /-- The good event and the actual coarse residual imply the score range. -/ theorem score_range {K L : ℕ} {δ E : ℝ} (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (hD : ∀ b, 0 ≤ D b ∧ D b ≤ (K : ℤ)) (he : ∀ i, |FineData.error D Z0 i| ≤ (L : ℝ) ^ 2) (hδ : 0 < δ) (hδ1 : δ < 1) (hE : 2 * E + 1 ≤ (L : ℝ) ^ 2) {a : ℝ × ℝ} (ha : a ∈ SkewParameters.good δ L E) (i : Fin K × GridPairs.Grid L) : -(2 * (L : ℤ) ^ 2) ≤ SkewScores.score δ Z0 i a ∧ SkewScores.score δ Z0 i a ≤ ((K : ℤ) + 5) * (L : ℤ) ^ 2 := by exact SkewScores.score_range Z0 (fun b => (D b : ℝ)) (FineData.error D Z0) (FineData.decomposition D Z0) (fun b => by exact_mod_cast hD b) he hδ hδ1 hE ha i /-- Every outcome of the full row-jitter product lies in the same finite window. -/ theorem jitter_mem_binWindow {K L H B : ℕ} {δ E : ℝ} (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (good : Finset (Fin K)) (hD : ∀ b, 0 ≤ D b ∧ D b ≤ (K : ℤ)) (he : ∀ i, |FineData.error D Z0 i| ≤ (L : ℝ) ^ 2) (hδ : 0 < δ) (hδ1 : δ < 1) (hE : 2 * E + 1 ≤ (L : ℝ) ^ 2) (hH : H ≤ L ^ 2) (hB : 0 < B) {a : ℝ × ℝ} (ha : a ∈ SkewParameters.good δ L E) (q : Fin K × Fin L → Fin H) (i : Fin (good.card * L ^ 2)) : (SkewScores.score δ Z0 (FineIndex.ambient good i) a - ((q (FineIndex.group good i)).val : ℤ)) / (B : ℤ) ∈ binWindow K L B := by apply FiniteBinWindow.mem_window (by exact_mod_cast hB) have hz := score_range D Z0 hD he hδ hδ1 hE ha (FineIndex.ambient good i) have hq : ((q (FineIndex.group good i)).val : ℤ) < (H : ℤ) := by exact_mod_cast (q (FineIndex.group good i)).isLt have hq0 : (0 : ℤ) ≤ (q (FineIndex.group good i)).val := by positivity have hHr : (H : ℤ) ≤ (L : ℤ) ^ 2 := by exact_mod_cast hH constructor <;> linarith /-- Exact intensity scaling and stability, with the square errors summed over all original blocks. Restricting the witness family only decreases that nonnegative sum. -/ theorem integral_intensity_excess_le {K L H : ℕ} {δ E ω : ℝ} (hL : 0 < L) (hH : 0 < H) (hHL : H ≤ L ^ 2) (hδ : 0 < δ) (hδ1 : δ < 1) (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (good : Finset (Fin K)) (hgood : Set.InjOn D good) (hη : ∀ b p, |FineData.perturbation D Z0 H b p| ≤ 1) {a : ℝ × ℝ} (ha : a ∈ SkewParameters.good δ L E) (hsquare : (∑ b : Fin K, MesoscopicProjection.squareError L δ ((H : ℝ) / (L : ℝ) ^ 2) (FineData.perturbation D Z0 H b) a) ≤ ω) : (∫ t, max 0 (CountIntensity.intensity H (fun i : Fin (good.card * L ^ 2) => SkewScores.score δ Z0 (FineIndex.ambient good i) a) t - 1)) ≤ (L : ℝ) ^ 2 * (δ * good.card + Real.sqrt (6 * good.card * ω) + 2 * good.card * (2 * E + 1) / H) := by letI : Nonempty (GridPairs.Grid L) := ⟨(⟨0, hL⟩, ⟨0, hL⟩)⟩ let Dg : good → ℤ := fun b => D b.val let Zg : good → GridPairs.Grid L → ℤ := fun b p => SkewScores.score δ Z0 (b.val, p) a let η : good → GridPairs.Grid L → ℝ := fun b => FineData.perturbation D Z0 H b.val let w : good → GridPairs.Grid L → ℝ := fun b p => ProjectionScaling.normalizedCenter H Zg b p - (Dg b : ℝ) have hLr : (0 : ℝ) < L := by exact_mod_cast hL have hHr : (0 : ℝ) < H := by exact_mod_cast hH have hm : (0 : ℝ) < (L : ℝ) ^ 2 := sq_pos_of_pos hLr have hh : 0 < (H : ℝ) / (L : ℝ) ^ 2 := div_pos hHr hm have hh1 : (H : ℝ) / (L : ℝ) ^ 2 ≤ 1 := by apply (div_le_one hm).2 exact_mod_cast hHL have hDg : Function.Injective Dg := by intro b c hbc exact Subtype.ext (hgood b.property c.property hbc) have hw (b : good) (p : GridPairs.Grid L) : |w b p - EmpiricalPairKernel.center L δ (η b) a p| ≤ (2 * E + 1) / (L : ℝ) ^ 2 := by have he := SkewScores.score_error_le Z0 ha (b.val, p) rw [FineData.decomposition D Z0 (b.val, p)] at he have hn := ProjectionScaling.normalized_error hL (Zg b p) (D b.val) (FineData.error D Z0 (b.val, p)) (SkewParameters.alpha δ a) (SkewParameters.beta a) H (2 * E + 1) p.1 p.2 he simpa [w, ProjectionScaling.normalizedCenter, Dg, η, FineData.perturbation, EmpiricalPairKernel.center, ParameterKernel.projection, GridQuadrature.sample, SkewParameters.alpha, SkewParameters.beta, GridPairs.Grid, pow_two] using hn have hsub : (∑ b : good, MesoscopicProjection.squareError L δ ((H : ℝ) / (L : ℝ) ^ 2) (η b) a) ≤ ω := by change (∑ b : good, MesoscopicProjection.squareError L δ ((H : ℝ) / (L : ℝ) ^ 2) (FineData.perturbation D Z0 H b.val) a) ≤ ω rw [Finset.sum_coe_sort good (fun b : Fin K => MesoscopicProjection.squareError L δ ((H : ℝ) / (L : ℝ) ^ 2) (FineData.perturbation D Z0 H b) a)] exact (Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ good) (fun b _ _ => MesoscopicProjection.squareError_nonneg _ _ _ _ _)).trans hsquare have hstable := AggregateDensity.integral_aggregate_excess_le_stable hL Dg hDg hδ hδ1 hh hh1 η (fun b p => hη b.val p) ha.1 w hw have hsqrt : Real.sqrt (6 * (good.card : ℝ) * ∑ b : good, MesoscopicProjection.squareError L δ ((H : ℝ) / (L : ℝ) ^ 2) (η b) a) ≤ Real.sqrt (6 * good.card * ω) := Real.sqrt_le_sqrt (mul_le_mul_of_nonneg_left hsub (by positivity)) simp only [Fintype.card_coe] at hstable have hcancel : 2 * (good.card : ℝ) * ((2 * E + 1) / (L : ℝ) ^ 2) / ((H : ℝ) / (L : ℝ) ^ 2) = 2 * good.card * (2 * E + 1) / H := by field_simp [hLr.ne', hHr.ne'] <;> ring rw [hcancel] at hstable have hbound : (∫ t, max 0 (AggregateDensity.aggregate Dg ((H : ℝ) / (L : ℝ) ^ 2) w t - 1)) ≤ δ * good.card + Real.sqrt (6 * good.card * ω) + 2 * good.card * (2 * E + 1) / H := by linarith have hid (t : ℝ) : CountIntensity.intensity H (fun i : Fin (good.card * L ^ 2) => SkewScores.score δ Z0 (FineIndex.ambient good i) a) t = ProjectionScaling.groupIntensity H Zg t := by rw [ProjectionScaling.intensity_eq_groupIntensity (FineIndex.witnessEquiv good)] simp only [FineIndex.ambient, Equiv.apply_symm_apply, Zg] simp_rw [hid] rw [ProjectionScaling.integral_groupIntensity_excess_degrees Dg Zg] exact mul_le_mul_of_nonneg_left hbound hm.le /-- Finite row jitters followed by bounded corrections on every original pin. The selected subset consists only of witnesses; the ambient block/grid space remains unchanged. -/ theorem exists_corrections {K L H B : ℕ} {δ E ω : ℝ} (hK : 0 < K) (hL : 0 < L) (hH : 0 < H) (hB : 0 < B) (hHL : H ≤ L ^ 2) (hδ : 0 < δ) (hδ1 : δ < 1) (hE0 : 0 ≤ E) (hE : 2 * E + 1 ≤ (L : ℝ) ^ 2) (hω : 0 ≤ ω) (D : Fin K → ℤ) (Z0 : Fin K × GridPairs.Grid L → ℤ) (good : Finset (Fin K)) (hgood : Set.InjOn D good) (hD : ∀ b, 0 ≤ D b ∧ D b ≤ (K : ℤ)) (he : ∀ i, |FineData.error D Z0 i| ≤ (L : ℝ) ^ 2) (hη : ∀ b p, |FineData.perturbation D Z0 H b p| ≤ 1) {a : ℝ × ℝ} (ha : a ∈ SkewParameters.good δ L E) (hsquare : (∑ b : Fin K, MesoscopicProjection.squareError L δ ((H : ℝ) / (L : ℝ) ^ 2) (FineData.perturbation D Z0 H b) a) ≤ ω) (hnear : RowPairAverage.count (SkewScores.score δ Z0) (B : ℤ) a / (L : ℝ) ^ 2 ≤ ω) : ∃ (q : Fin K × Fin L → Fin H) (q2 : Fin K → Fin (L ^ 2) → ℤ) (S : Finset (Fin (good.card * L ^ 2))), (∀ b w, 0 ≤ q2 b w ∧ q2 b w ≤ 2 * (B : ℤ)) ∧ Set.InjOn (fun i => SkewScores.score δ Z0 (FineIndex.ambient good i) a - ((q (FineIndex.group good i)).val : ℤ) - q2 (FineIndex.ambient good i).1 (CoarseLabels.gridEquiv L (FineIndex.ambient good i).2)) S ∧ (1 - δ) * good.card * (L : ℝ) ^ 2 - (L : ℝ) ^ 2 * Real.sqrt (6 * good.card * ω) - 2 * good.card * (L : ℝ) ^ 2 * (2 * E + 1) / H - Real.sqrt (((binWindow K L B).card : ℝ) * (good.card * (L : ℝ) ^ 2 + 2 * ω * (L : ℝ) ^ 2)) ≤ S.card := by let Z : Fin (good.card * L ^ 2) → ℤ := fun i => SkewScores.score δ Z0 (FineIndex.ambient good i) a let g : Fin (good.card * L ^ 2) → Fin K × Fin L := FineIndex.group good let J := binWindow K L B have hBz : (0 : ℤ) < B := by exact_mod_cast hB have hLr : (0 : ℝ) < L := by exact_mod_cast hL have hm : (0 : ℝ) < (L : ℝ) ^ 2 := sq_pos_of_pos hLr have hraw := integral_intensity_excess_le hL hH hHL hδ hδ1 D Z0 good hgood hη ha hsquare have hmean := CountIntensity.sum_jitterMean_excess_le_integral hH Z hBz J have hmeanBound : (∑ j ∈ J, max 0 (CountIntensity.jitterMean H Z (B : ℤ) j - (B : ℝ))) ≤ (L : ℝ) ^ 2 * (δ * good.card + Real.sqrt (6 * good.card * ω) + 2 * good.card * (2 * E + 1) / H) := hmean.trans hraw have hpairs := RowPairAverage.twice_reindexed_unordered_count_le (FineIndex.ambient good) (FineIndex.ambient_injective good) (SkewScores.score δ Z0) (B : ℤ) a have hnear' := (div_le_iff₀ hm).mp hnear have hvariance : ((good.card * L ^ 2 : ℕ) : ℝ) + 2 * ((Finset.univ.filter (fun p : Fin (good.card * L ^ 2) × Fin (good.card * L ^ 2) => p.1 < p.2 ∧ g p.1 = g p.2 ∧ |Z p.1 - Z p.2| < (B : ℤ))).card : ℝ) ≤ good.card * (L : ℝ) ^ 2 + 2 * ω * (L : ℝ) ^ 2 := by change 2 * ((Finset.univ.filter (fun p : Fin (good.card * L ^ 2) × Fin (good.card * L ^ 2) => p.1 < p.2 ∧ g p.1 = g p.2 ∧ |Z p.1 - Z p.2| < (B : ℤ))).card : ℝ) ≤ _ at hpairs push_cast nlinarith [mul_nonneg hω hm.le] obtain ⟨q, hq⟩ := JitterSelection.exists_jitter_overflow H hH Z g (B : ℤ) hBz J have hsqrt := Real.sqrt_le_sqrt (mul_le_mul_of_nonneg_left hvariance (show (0 : ℝ) ≤ J.card by positivity)) have hoverflow : (∑ j ∈ J, max 0 ((CountIntensity.binCount (fun i => Z i - ((q (g i)).val : ℤ)) (B : ℤ) j : ℝ) - (B : ℝ))) ≤ (L : ℝ) ^ 2 * (δ * good.card + Real.sqrt (6 * good.card * ω) + 2 * good.card * (2 * E + 1) / H) + Real.sqrt ((J.card : ℝ) * (good.card * (L : ℝ) ^ 2 + 2 * ω * (L : ℝ) ^ 2)) := hq.trans (add_le_add hmeanBound hsqrt) have hsupport (i : Fin (good.card * L ^ 2)) : (Z i - ((q (g i)).val : ℤ)) / (B : ℤ) ∈ J := jitter_mem_binWindow D Z0 good hD he hδ hδ1 hE hHL hB ha q i obtain ⟨S, c, _, _, hloss, hc, hzero, hinj, _⟩ := FiniteBinWindow.exists_supported_witnesses (fun i => Z i - ((q (g i)).val : ℤ)) B hB J hsupport have hc0 (i) : 0 ≤ c i := by by_cases hi : i ∈ S · exact le_trans (by norm_num) (hc i hi).1 · rw [hzero i hi] have hcB (i) : c i ≤ 2 * (B : ℤ) := by by_cases hi : i ∈ S · linarith [(hc i hi).2] · rw [hzero i hi] positivity let q2 := FineIndex.extendCorrection good c have hb := FineIndex.extendCorrection_bounds good c (show (0 : ℤ) ≤ 2 * B by positivity) hc0 hcB refine ⟨q, q2, S, (fun b w => ⟨hb.1 b w, hb.2 b w⟩), ?_, ?_⟩ · simpa only [q2, FineIndex.extendCorrection_at, Z, g] using hinj · have hloss' : (good.card : ℝ) * (L : ℝ) ^ 2 - S.card ≤ (L : ℝ) ^ 2 * (δ * good.card + Real.sqrt (6 * good.card * ω) + 2 * good.card * (2 * E + 1) / H) + Real.sqrt ((J.card : ℝ) * (good.card * (L : ℝ) ^ 2 + 2 * ω * (L : ℝ) ^ 2)) := by simpa only [Nat.cast_mul, Nat.cast_pow] using hloss.le.trans hoverflow have hsplit : (L : ℝ) ^ 2 * (δ * good.card + Real.sqrt (6 * good.card * ω) + 2 * good.card * (2 * E + 1) / H) = δ * good.card * (L : ℝ) ^ 2 + (L : ℝ) ^ 2 * Real.sqrt (6 * good.card * ω) + 2 * good.card * (L : ℝ) ^ 2 * (2 * E + 1) / H := by ring rw [hsplit] at hloss' dsimp only [J] at hloss' nlinarith end DistanceCounts.FineFixedCorrection end end BodyFile095 -- Source: DistanceCounts/FineSelection.lean section BodyFile096 /-! Vanishing-loss fine selection from the actual deterministic coarse residual. -/ noncomputable section open Filter open scoped Topology BigOperators Classical namespace DistanceCounts.FineSelection open ConstructionScales /-- The three losses are empirical density error, floor discrepancy, and the variance of the actual finite reachable-bin window. -/ def loss (K G : ℕ) (ω : ℕ → ℝ) (L : ℕ) : ℝ := Real.sqrt (6 * G * ω L) + 2 * G * (2 * E L + 1) / H L + Real.sqrt (((FineFixedCorrection.binWindow K L (B K L)).card : ℝ) * (G * (L : ℝ) ^ 2 + 2 * ω L * (L : ℝ) ^ 2)) / (L : ℝ) ^ 2 theorem loss_nonneg (K G : ℕ) (ω : ℕ → ℝ) (L : ℕ) : 0 ≤ loss K G ω L := by unfold loss E positivity /-- The variance term tends to zero by its actual window-cardinality estimate, not by any assumed probabilistic or expected-error bound. -/ theorem tendsto_loss {K : ℕ} (hK : 0 < K) (G : ℕ) {ω : ℕ → ℝ} (hω : ∀ L, 0 ≤ ω L) (hωt : Tendsto ω atTop (𝓝 0)) : Tendsto (loss K G ω) atTop (𝓝 0) := by have hQ : Tendsto (fun L : ℕ => (ω L * (L : ℝ) ^ 2) / (L : ℝ) ^ 2) atTop (𝓝 0) := by apply hωt.congr' filter_upwards [eventually_gt_atTop 0] with L hL have hLr : (L : ℝ) ≠ 0 := by exact_mod_cast hL.ne' field_simp [hLr] have hJ : ∀ᶠ L : ℕ in atTop, ((FineFixedCorrection.binWindow K L (B K L)).card : ℝ) ≤ ((K : ℝ) + 8) * (L : ℝ) ^ 2 / B K L + 2 := by filter_upwards [eventually_pos hK] with L hp exact FineFixedCorrection.card_binWindow_le K L hp.2.1 have hv := variance_loss hK (G := (G : ℝ)) (C := (K : ℝ) + 8) (by positivity) (by positivity) (fun L => ω L * (L : ℝ) ^ 2) (fun L => (FineFixedCorrection.binWindow K L (B K L)).card) (fun L => mul_nonneg (hω L) (sq_nonneg _)) hQ hJ have hv' : Tendsto (fun L : ℕ => Real.sqrt (((FineFixedCorrection.binWindow K L (B K L)).card : ℝ) * (G * (L : ℝ) ^ 2 + 2 * ω L * (L : ℝ) ^ 2)) / (L : ℝ) ^ 2) atTop (𝓝 0) := by simpa only [mul_assoc] using hv have hs := Real.continuous_sqrt.continuousAt.tendsto.comp (hωt.const_mul (6 * (G : ℝ))) simp only [mul_zero, Real.sqrt_zero] at hs have hd : Tendsto (fun L : ℕ => 2 * (G : ℝ) * (2 * E L + 1) / H L) atTop (𝓝 0) := by simpa only [mul_zero, mul_div_assoc] using tendsto_discrepancy_div_H.const_mul (2 * (G : ℝ)) unfold loss simpa only [Function.comp_def, add_zero] using (hs.add hd).add hv' /-- Actual common parameters, row jitters, and bounded unary corrections exist at every sufficiently large scale, from the deterministic residual alone. Only the witness indices are restricted to `good`; corrections retain the full original ambient block/grid domain. -/ theorem exists_selection {K : ℕ} (hK : 0 < K) {δ : ℝ} (hδ : 0 < δ) (hδ1 : δ < 1) (D : Fin K → ℤ) (good : Finset (Fin K)) (hgood : Set.InjOn D good) (hD : ∀ b, 0 ≤ D b ∧ D b ≤ (K : ℤ)) (Z0 : (L : ℕ) → Fin K × GridPairs.Grid L → ℤ) {r : ℕ → ℝ} (hr : Tendsto r atTop (𝓝 0)) (herr : ∀ᶠ L in atTop, ∀ i, |FineData.error D (Z0 L) i| ≤ r L * (L : ℝ) ^ 2) : ∃ loss : ℕ → ℝ, (∀ L, 0 ≤ loss L) ∧ Tendsto loss atTop (𝓝 0) ∧ ∀ᶠ L in atTop, ∃ a ∈ SkewParameters.good δ L (E L), ∃ (q : Fin K × Fin L → Fin (H L)) (q2 : Fin K → Fin (L ^ 2) → ℤ) (S : Finset (Fin (good.card * L ^ 2))), (∀ b w, 0 ≤ q2 b w ∧ q2 b w ≤ 2 * (B K L : ℤ)) ∧ Set.InjOn (fun i => SkewScores.score δ (Z0 L) (FineIndex.ambient good i) a - ((q (FineIndex.group good i)).val : ℤ) - q2 (FineIndex.ambient good i).1 (CoarseLabels.gridEquiv L (FineIndex.ambient good i).2)) S ∧ (1 - δ) * good.card * (L : ℝ) ^ 2 - loss L * (L : ℝ) ^ 2 ≤ S.card := by obtain ⟨ω, hω, hωt, hparameters⟩ := FineParameterChoice.exists_parameters hK hδ hδ1 D Z0 hr herr refine ⟨loss K good.card ω, loss_nonneg K good.card ω, tendsto_loss hK good.card hω hωt, ?_⟩ have hsmall := tendsto_h.eventually (gt_mem_nhds (by norm_num : (0 : ℝ) < 1)) have hdiscrepancy := tendsto_discrepancy_div_H.eventually (gt_mem_nhds (by norm_num : (0 : ℝ) < 1)) have hrsmall := hr.eventually (gt_mem_nhds (by norm_num : (0 : ℝ) < 1)) have hperturbation := (FineParameterChoice.tendsto_perturbationEnvelope hr).eventually (gt_mem_nhds (by norm_num : (0 : ℝ) < 1)) filter_upwards [hparameters, herr, eventually_pos hK, eventually_gt_atTop 0, hsmall, hdiscrepancy, hrsmall, hperturbation] with L hparameters he hp hL hh hd hr1 hη1 have hLr : (0 : ℝ) < L := by exact_mod_cast hL have hHr : (0 : ℝ) < H L := by exact_mod_cast hp.1 have hm : (0 : ℝ) < (L : ℝ) ^ 2 := sq_pos_of_pos hLr have hHLr : (H L : ℝ) ≤ (L : ℝ) ^ 2 := (div_le_one hm).mp hh.le have hHL : H L ≤ L ^ 2 := by exact_mod_cast hHLr have hE : 2 * E L + 1 ≤ (L : ℝ) ^ 2 := ((div_le_one hHr).mp hd.le).trans hHLr have he' (i) : |FineData.error D (Z0 L) i| ≤ (L : ℝ) ^ 2 := by exact (he i).trans (by nlinarith) have hη (b : Fin K) (p : GridPairs.Grid L) : |FineData.perturbation D (Z0 L) (H L) b p| ≤ 1 := (FineParameterChoice.perturbation_le D (Z0 L) hL he b p).trans hη1.le obtain ⟨a, ha, hsquare, hnear⟩ := hparameters obtain ⟨q, q2, S, hq2, hinj, hcard⟩ := FineFixedCorrection.exists_corrections hK hL hp.1 hp.2.1 hHL hδ hδ1 (show 0 ≤ E L by unfold E; positivity) hE (hω L) D (Z0 L) good hgood hD he' hη ha (by simpa only [FineParameterChoice.empiricalCost, h] using hsquare) hnear refine ⟨a, ha, q, q2, S, hq2, hinj, ?_⟩ have hid : (1 - δ) * good.card * (L : ℝ) ^ 2 - loss K good.card ω L * (L : ℝ) ^ 2 = (1 - δ) * good.card * (L : ℝ) ^ 2 - (L : ℝ) ^ 2 * Real.sqrt (6 * good.card * ω L) - 2 * good.card * (L : ℝ) ^ 2 * (2 * E L + 1) / H L - Real.sqrt (((FineFixedCorrection.binWindow K L (B K L)).card : ℝ) * (good.card * (L : ℝ) ^ 2 + 2 * ω L * (L : ℝ) ^ 2)) := by unfold loss field_simp [hLr.ne', hHr.ne'] <;> ring rw [hid] exact hcard end DistanceCounts.FineSelection end end BodyFile096 -- Source: DistanceCounts/CoarseCounts.lean section BodyFile097 noncomputable section namespace DistanceCounts.CoarseCounts open Finset CoarseGrid PairModulus CoarseConditions open scoped Classical variable {s L : ℕ} {p : Fin (2 * s) ⊕ Fin (2 * s) → ℕ} {z : Fin (2 * s) ⊕ Fin (2 * s) → GaussianInt} {ε : ℝ} /-- Only the pin itself is omitted, and only from its target palette. -/ def blockTargets (i : PinIndex (2 * s) L) (c : Fin (2 * s) × Fin (2 * s)) : Finset (GridPairs.Grid L) := univ.filter fun y => (c, y) ≠ i def blockVectors (p : Fin (2 * s) ⊕ Fin (2 * s) → ℕ) (z : Fin (2 * s) ⊕ Fin (2 * s) → GaussianInt) (i : PinIndex (2 * s) L) (c : Fin (2 * s) × Fin (2 * s)) : Finset GaussianInt := (blockTargets i c).image fun y => encodedDifference p z i (c, y) def blockNorms (p : Fin (2 * s) ⊕ Fin (2 * s) → ℕ) (z : Fin (2 * s) ⊕ Fin (2 * s) → GaussianInt) (i : PinIndex (2 * s) L) (c : Fin (2 * s) × Fin (2 * s)) : Finset ℕ := (blockVectors p z i c).image fun v => v.norm.natAbs def blockPalette (p : Fin (2 * s) ⊕ Fin (2 * s) → ℕ) (z : Fin (2 * s) ⊕ Fin (2 * s) → GaussianInt) (i : PinIndex (2 * s) L) (c : Fin (2 * s) × Fin (2 * s)) : Finset ℝ := (blockTargets i c).image fun y => sqDist (pin p z i) (pin p z (c, y)) theorem pin_injective (h : Admissible s L p z ε) : Function.Injective (pin (L := L) p z) := CoarseGrid.pin_injective p z h.prime h.injective (fun k => GaussianNorm.not_dvd_of_isUnit_residue (p k) (h.prime k) (h.inert k) (z k) (h.units k)) h.inert /-- No block or point is removed from the physical configuration. -/ theorem pins_card (h : Admissible s L p z ε) : (pins L p z).card = (2 * s) ^ 2 * L ^ 2 := CoarseGrid.pins_card p z h.prime h.injective (fun k => GaussianNorm.not_dvd_of_isUnit_residue (p k) (h.prime k) (h.inert k) (z k) (h.units k)) h.inert /-- Squaring preserves the cardinal of the actual nonnegative distance image. -/ theorem pinnedCount_eq_sqDist_card (X : Finset Point) (a : Point) : pinnedCount X a = ((X.erase a).image (sqDist a)).card := by have he : (distanceValues X a).image (fun d => d ^ 2) = (X.erase a).image (sqDist a) := by simp only [distanceValues, image_image, Function.comp_def] apply image_congr intro x _ exact (sqDist_eq_dist_sq a x).symm rw [← he, card_image_of_injOn] · rfl · intro x hx y hy hxy have hx0 := (distanceValues_pos hx).le have hy0 := (distanceValues_pos hy).le nlinarith theorem blockPalettes_disjoint (h : Admissible s L p z ε) (i : PinIndex (2 * s) L) {c d : Fin (2 * s) × Fin (2 * s)} (hcd : c ≠ d) : Disjoint (blockPalette p z i c) (blockPalette p z i d) := by apply disjoint_left.mpr intro r hr hs obtain ⟨x, _, hx⟩ := mem_image.mp hr obtain ⟨y, _, hy⟩ := mem_image.mp hs exact sqDist_ne_of_targetBlock_ne p z h.prime h.injective h.inert h.units i (c, x) (d, y) hcd (hx.trans hy.symm) /-- Exact partition by every original block, including the pin's own block. -/ theorem squaredValues_eq_biUnion (h : Admissible s L p z ε) (i : PinIndex (2 * s) L) : ((pins L p z).erase (pin p z i)).image (sqDist (pin p z i)) = univ.biUnion (blockPalette p z i) := by ext r constructor · intro hr obtain ⟨a, ha, rfl⟩ := mem_image.mp hr obtain ⟨hne, ha⟩ := mem_erase.mp ha obtain ⟨j, _, rfl⟩ := mem_image.mp ha refine mem_biUnion.mpr ⟨j.1, mem_univ _, mem_image.mpr ⟨j.2, ?_, rfl⟩⟩ exact mem_filter.mpr ⟨mem_univ _, fun he => hne (congrArg (pin p z) he)⟩ · intro hr obtain ⟨c, _, hr⟩ := mem_biUnion.mp hr obtain ⟨y, hy, rfl⟩ := mem_image.mp hr refine mem_image.mpr ⟨pin p z (c, y), mem_erase.mpr ⟨?_, pin_mem p z _⟩, rfl⟩ exact fun he => (mem_filter.mp hy).2 (pin_injective h he) theorem pinnedCount_eq_sum (h : Admissible s L p z ε) (i : PinIndex (2 * s) L) : pinnedCount (pins L p z) (pin p z i) = ∑ c, (blockPalette p z i c).card := by rw [pinnedCount_eq_sqDist_card, squaredValues_eq_biUnion h i] apply card_biUnion intro c _ d _ hcd exact blockPalettes_disjoint h i hcd private theorem normQuotient_real (v : GaussianInt) (q : ℕ) : (GaussianNorm.normQuotient v q : ℝ) = (v.norm.natAbs : ℝ) / (q : ℝ) ^ 2 := by simp [GaussianNorm.normQuotient, GaussianInt.natCast_natAbs_norm] /-- Norm labels and geometric squared-distance labels have exactly the same size. -/ theorem blockPalette_card (h : Admissible s L p z ε) (i : PinIndex (2 * s) L) (c : Fin (2 * s) × Fin (2 * s)) : (blockPalette p z i c).card = (blockNorms p z i c).card := by have he : blockPalette p z i c = (blockNorms p z i c).image (fun n : ℕ => (n : ℝ) / (modulus p i.1 c : ℝ) ^ 2) := by simp only [blockPalette, blockNorms, blockVectors, image_image, Function.comp_def] apply image_congr intro y _ exact (sqDist_eq_normQuotient p z h.prime i (c, y)).trans (normQuotient_real _ _) rw [he] apply card_image_of_injective intro a b hab have hq : (modulus p i.1 c : ℝ) ^ 2 ≠ 0 := by exact pow_ne_zero 2 (by exact_mod_cast (modulus_pos p h.prime i.1 c).ne') exact_mod_cast (div_left_inj' hq).mp hab private theorem encodedDifference_ne_zero (h : Admissible s L p z ε) (i j : PinIndex (2 * s) L) (hji : j ≠ i) : encodedDifference p z i j ≠ 0 := by intro he have hc := pin_sub_coordinates p z h.prime i j rw [he] at hc simp only [Zsqrtd.re_zero, Zsqrtd.im_zero, Int.cast_zero, zero_div] at hc have hp : pin p z i = pin p z j := by ext k fin_cases k · exact sub_eq_zero.mp hc.1 · exact sub_eq_zero.mp hc.2 exact hji (pin_injective h hp).symm /-- Every actual vector has the advertised disk, unit class, and is nonzero. -/ theorem blockVectors_spec (h : Admissible s L p z ε) (hL : 0 < L) (i : PinIndex (2 * s) L) (c : Fin (2 * s) × Fin (2 * s)) {v : GaussianInt} (hv : v ∈ blockVectors p z i c) : v ≠ 0 ∧ v ∈ gaussianDisk 0 (pairRadius L p i.1 c) ∧ GaussianNorm.residue (modulus p i.1 c) v = pairResidue p z i.1 c ∧ IsUnit (GaussianNorm.residue (modulus p i.1 c) v) := by obtain ⟨y, hy, rfl⟩ := mem_image.mp hv exact ⟨encodedDifference_ne_zero h i (c, y) (mem_filter.mp hy).2, encodedDifference_mem_disk p z h.prime h.bounded hL i (c, y), encodedDifference_residue p z i (c, y), encodedDifference_isUnit p z h.prime h.injective i (c, y) (fun k _ => h.units k)⟩ theorem blockNorms_subset (h : Admissible s L p z ε) (hL : 0 < L) (i : PinIndex (2 * s) L) (c : Fin (2 * s) × Fin (2 * s)) : blockNorms p z i c ⊆ LowPalette.normPalette (pairResidue p z i.1 c) (pairRadius L p i.1 c) := by intro n hn obtain ⟨v, hv, rfl⟩ := mem_image.mp hn obtain ⟨hv0, hvR, hvres, _⟩ := blockVectors_spec h hL i c hv refine mem_image.mpr ⟨v, mem_filter.mpr ⟨?_, hvres⟩, rfl⟩ apply (GaussianMass.mem_representatives (sq_nonneg _) v).mpr refine ⟨hv0, ?_⟩ have hR : 0 ≤ pairRadius L p i.1 c := by unfold pairRadius; positivity have hnorm : ‖(v : ℂ)‖ ≤ pairRadius L p i.1 c := by simpa only [mem_gaussianDisk, dist_zero_right] using hvR change GaussianDivisibility.normMass v ≤ _ rw [GaussianDivisibility.normMass_eq_sq_norm] exact (sq_le_sq₀ (norm_nonneg _) hR).mpr hnorm /-- Removing actual colliders makes the norm map injective. -/ theorem norm_injective_off_colliders (h : Admissible s L p z ε) (hL : 0 < L) (i : PinIndex (2 * s) L) (c : Fin (2 * s) × Fin (2 * s)) : Set.InjOn (fun v : GaussianInt => v.norm.natAbs) (↑(blockVectors p z i c \ ResidueExceptions.collisionFiber (modulus p i.1 c) (pairRadius L p i.1 c) (pairResidue p z i.1 c)) : Set GaussianInt) := by intro v hv w hw hn obtain ⟨hvV, hvbad⟩ := mem_sdiff.mp hv obtain ⟨hwV, _⟩ := mem_sdiff.mp hw by_contra hvw obtain ⟨hv0, hvR, hvres, hvunit⟩ := blockVectors_spec h hL i c hvV obtain ⟨_, hwR, hwres, _⟩ := blockVectors_spec h hL i c hwV apply hvbad apply (ResidueExceptions.mem_collisionFiber _ _ _ _).mpr refine ⟨(HighCollisionCover.mem_collisionVectors _ _ _).mpr ⟨hv0, ?_, hvunit, w, hwR, Ne.symm hvw, ?_, hvres.trans hwres.symm⟩, hvres⟩ · simpa only [mem_gaussianDisk, dist_zero_right] using hvR · have hh := congrArg (fun n : ℕ => (n : ℤ)) hn simpa only [GaussianInt.natCast_natAbs_norm, Int.cast_id] using hh /-- The lost norm-image cardinal is bounded by actual colliding vectors. -/ theorem blockVectors_card_le (h : Admissible s L p z ε) (hL : 0 < L) (i : PinIndex (2 * s) L) (c : Fin (2 * s) × Fin (2 * s)) : (blockVectors p z i c).card ≤ (blockPalette p z i c).card + (ResidueExceptions.collisionFiber (modulus p i.1 c) (pairRadius L p i.1 c) (pairResidue p z i.1 c)).card := by rw [blockPalette_card h i c] have hgood : (blockVectors p z i c \ ResidueExceptions.collisionFiber (modulus p i.1 c) (pairRadius L p i.1 c) (pairResidue p z i.1 c)).card ≤ (blockNorms p z i c).card := by calc _ = ((blockVectors p z i c \ ResidueExceptions.collisionFiber (modulus p i.1 c) (pairRadius L p i.1 c) (pairResidue p z i.1 c)).image (fun v : GaussianInt => v.norm.natAbs)).card := (card_image_of_injOn (norm_injective_off_colliders h hL i c)).symm _ ≤ (blockNorms p z i c).card := card_le_card (image_subset_image sdiff_subset) exact card_le_card_sdiff_add_card.trans (Nat.add_le_add_right hgood _) theorem blockPalette_card_le_grid (i : PinIndex (2 * s) L) (c : Fin (2 * s) × Fin (2 * s)) : (blockPalette p z i c).card ≤ L ^ 2 := by calc _ ≤ (blockTargets i c).card := card_image_le _ ≤ (univ : Finset (GridPairs.Grid L)).card := card_le_card (filter_subset _ _) _ = L ^ 2 := by simp [GridPairs.Grid, pow_two] theorem selfblock_low (i : PinIndex (2 * s) L) : (i.1.1.val, i.1.2.val) ∉ highTargets s i.1.1.val i.1.2.val := by simp [highTargets] theorem high_blockVectors_card (h : Admissible s L p z ε) (i : PinIndex (2 * s) L) (c : Fin (2 * s) × Fin (2 * s)) (hc : (c.1.val, c.2.val) ∈ highTargets s i.1.1.val i.1.2.val) : (blockVectors p z i c).card = L ^ 2 := by have hci : c ≠ i.1 := by intro he; subst c; exact selfblock_low i hc have ht : blockTargets i c = univ := by ext y simp only [blockTargets, mem_filter, mem_univ, true_and, iff_true] exact fun he => hci (congrArg Prod.fst he) rw [blockVectors, card_image_of_injective _ (encodedDifference_injective p z h.prime i c), ht] simp [GridPairs.Grid, pow_two] /-- The per-block estimate follows from the appropriate actual finite palette. -/ theorem block_error (h : Admissible s L p z ε) (hL : 0 < L) (i : PinIndex (2 * s) L) (c : Fin (2 * s) × Fin (2 * s)) : |((blockPalette p z i c).card : ℝ) - (if (c.1.val, c.2.val) ∈ highTargets s i.1.1.val i.1.2.val then (L : ℝ) ^ 2 else 0)| ≤ ε * (L : ℝ) ^ 2 := by have hb := h.palettes i.1 c by_cases hc : (c.1.val, c.2.val) ∈ highTargets s i.1.1.val i.1.2.val · rw [if_pos hc] at hb ⊢ have hlo := blockVectors_card_le h hL i c rw [high_blockVectors_card h i c hc] at hlo have hlo' : (L : ℝ) ^ 2 ≤ (blockPalette p z i c).card + (ResidueExceptions.collisionFiber (modulus p i.1 c) (pairRadius L p i.1 c) (pairResidue p z i.1 c)).card := by exact_mod_cast hlo have hhi : ((blockPalette p z i c).card : ℝ) ≤ (L : ℝ) ^ 2 := by exact_mod_cast blockPalette_card_le_grid (p := p) (z := z) i c rw [abs_of_nonpos (sub_nonpos.mpr hhi)] linarith · rw [if_neg hc] at hb ⊢ rw [sub_zero, abs_of_nonneg (Nat.cast_nonneg _), blockPalette_card h i c] have hcard : ((blockNorms p z i c).card : ℝ) ≤ (LowPalette.normPalette (pairResidue p z i.1 c) (pairRadius L p i.1 c)).card := by exact_mod_cast card_le_card (blockNorms_subset h hL i c) exact hcard.trans hb /-- Uniform approximation at every canonical pin of the unchanged configuration. -/ theorem pinnedCount_approx (hs : 0 < s) (hL : 0 < L) (h : Admissible s L p z ε) (i : PinIndex (2 * s) L) : |(pinnedCount (pins L p z) (pin p z i) : ℝ) - (coarseDegree s i.1.1.val i.1.2.val : ℝ) * (L : ℝ) ^ 2| ≤ ((2 * s : ℕ) : ℝ) ^ 2 * ε * (L : ℝ) ^ 2 := by have hdeg : ∑ c : Fin (2 * s) × Fin (2 * s), (if (c.1.val, c.2.val) ∈ highTargets s i.1.1.val i.1.2.val then (L : ℝ) ^ 2 else 0) = (coarseDegree s i.1.1.val i.1.2.val : ℝ) * (L : ℝ) ^ 2 := by have hc : ((ThresholdWeights.highTargetBlocks i.1).card : ℝ) = (coarseDegree s i.1.1.val i.1.2.val : ℝ) := by exact_mod_cast ThresholdWeights.card_highTargetBlocks hs i.1 rw [← hc] rw [← sum_filter] have hf : univ.filter (fun c : Fin (2 * s) × Fin (2 * s) => (c.1.val, c.2.val) ∈ highTargets s i.1.1.val i.1.2.val) = ThresholdWeights.highTargetBlocks i.1 := by ext c simp only [ThresholdWeights.highTargetBlocks, mem_filter, mem_univ, true_and, ThresholdWeights.log_two_lt_pairExponent_iff hs] rw [hf] simp rw [pinnedCount_eq_sum h i, Nat.cast_sum, ← hdeg, ← sum_sub_distrib] calc _ ≤ ∑ c : Fin (2 * s) × Fin (2 * s), |((blockPalette p z i c).card : ℝ) - (if (c.1.val, c.2.val) ∈ highTargets s i.1.1.val i.1.2.val then (L : ℝ) ^ 2 else 0)| := abs_sum_le_sum_abs _ _ _ ≤ ∑ _c : Fin (2 * s) × Fin (2 * s), ε * (L : ℝ) ^ 2 := sum_le_sum fun c _ => block_error h hL i c _ = _ := by simp [pow_two]; ring theorem full_configuration (hs : 0 < s) (hL : 0 < L) (h : Admissible s L p z ε) : (pins L p z).card = (2 * s) ^ 2 * L ^ 2 ∧ ∀ i : PinIndex (2 * s) L, |(pinnedCount (pins L p z) (pin p z i) : ℝ) - (coarseDegree s i.1.1.val i.1.2.val : ℝ) * (L : ℝ) ^ 2| ≤ ((2 * s : ℕ) : ℝ) ^ 2 * ε * (L : ℝ) ^ 2 := ⟨pins_card h, pinnedCount_approx hs hL h⟩ end DistanceCounts.CoarseCounts end end BodyFile097 -- Source: DistanceCounts/DegreeIndices.lean section BodyFile098 /-! Natural block indices and the full family of distinct good coarse degrees. -/ noncomputable section namespace DistanceCounts.DegreeIndices open Finset open scoped Classical def blockEquiv (s : ℕ) : (Fin (2 * s) × Fin (2 * s)) ≃ Fin ((2 * s) ^ 2) := CoarseLabels.gridEquiv (2 * s) def coordinates (s : ℕ) (k : Fin ((2 * s) ^ 2)) : ℕ × ℕ := ⟨((blockEquiv s).symm k).1.val, ((blockEquiv s).symm k).2.val⟩ def degree (s : ℕ) (k : Fin ((2 * s) ^ 2)) : ℤ := coarseDegree s (coordinates s k).1 (coordinates s k).2 def good (s : ℕ) : Finset (Fin ((2 * s) ^ 2)) := univ.filter (fun k => coordinates s k ∈ goodBlockIndices s) theorem coordinates_injective (s : ℕ) : Function.Injective (coordinates s) := by intro i j hij apply (blockEquiv s).symm.injective apply Prod.ext · apply Fin.ext exact congrArg Prod.fst hij · apply Fin.ext exact congrArg Prod.snd hij theorem image_good (s : ℕ) : (good s).image (coordinates s) = goodBlockIndices s := by ext ab constructor · intro hab obtain ⟨i, hi, rfl⟩ := mem_image.mp hab exact (mem_filter.mp hi).2 · intro hab have hb := hab simp only [goodBlockIndices, mem_product, mem_erase, mem_range] at hb let b : Fin (2 * s) × Fin (2 * s) := ⟨⟨ab.1, hb.1.2⟩, ⟨ab.2, hb.2.2⟩⟩ have hc : coordinates s (blockEquiv s b) = ab := by simp only [coordinates, Equiv.symm_apply_apply, b, Prod.mk.eta] exact mem_image.mpr ⟨blockEquiv s b, mem_filter.mpr ⟨mem_univ _, by rw [hc]; exact hab⟩, hc⟩ theorem card_good {s : ℕ} (hs : 0 < s) : (good s).card = (2 * s - 1) ^ 2 := by rw [← card_image_of_injective (good s) (coordinates_injective s), image_good] exact card_goodBlockIndices hs theorem degree_injective {s : ℕ} (hs : 0 < s) : Set.InjOn (degree s) (good s) := by intro i hi j hj hij have hi' := (mem_filter.mp hi).2 have hj' := (mem_filter.mp hj).2 simp only [goodBlockIndices, mem_product, mem_erase, mem_range] at hi' hj' have h := coarseDegree_injective hs hi'.1.2 hi'.2.2 hj'.1.2 hj'.2.2 hi'.1.1 hi'.2.1 hj'.1.1 hj'.2.1 hij exact coordinates_injective s (Prod.ext h.1 h.2) theorem degree_bounds {s : ℕ} (hs : 0 < s) (k : Fin ((2 * s) ^ 2)) : 0 ≤ degree s k ∧ degree s k ≤ (((2 * s) ^ 2 : ℕ) : ℤ) := by have ha : (coordinates s k).1 < 2 * s := ((blockEquiv s).symm k).1.isLt have hb : (coordinates s k).2 < 2 * s := ((blockEquiv s).symm k).2.isLt have hc := card_highTargets hs ha hb have hcard : (highTargets s (coordinates s k).1 (coordinates s k).2).card ≤ (2 * s) ^ 2 := by calc _ ≤ ((range (2 * s)) ×ˢ (range (2 * s))).card := card_le_card (filter_subset _ _) _ = _ := by simp only [card_product, card_range, pow_two] unfold degree rw [← hc] exact ⟨by positivity, by exact_mod_cast hcard⟩ def pinIndex (s L : ℕ) : (Fin ((2 * s) ^ 2) × GridPairs.Grid L) ≃ CoarseGrid.PinIndex (2 * s) L := Equiv.prodCongr (blockEquiv s).symm (Equiv.refl _) theorem pinIndex_apply (s L : ℕ) (i : Fin ((2 * s) ^ 2) × GridPairs.Grid L) : pinIndex s L i = ((blockEquiv s).symm i.1, i.2) := by cases i rfl def initialCounts {s L : ℕ} (p : Fin (2 * s) ⊕ Fin (2 * s) → ℕ) (z : Fin (2 * s) ⊕ Fin (2 * s) → GaussianInt) (i : Fin ((2 * s) ^ 2) × GridPairs.Grid L) : ℤ := pinnedCount (CoarseGrid.pins L p z) (CoarseGrid.pin p z (pinIndex s L i)) theorem initialCounts_error {s L : ℕ} {p : Fin (2 * s) ⊕ Fin (2 * s) → ℕ} {z : Fin (2 * s) ⊕ Fin (2 * s) → GaussianInt} {ε : ℝ} (hs : 0 < s) (hL : 0 < L) (ha : CoarseConditions.Admissible s L p z ε) (i : Fin ((2 * s) ^ 2) × GridPairs.Grid L) : |FineData.error (degree s) (initialCounts p z) i| ≤ (((2 * s) ^ 2 : ℕ) : ℝ) * ε * (L : ℝ) ^ 2 := by rcases i with ⟨k, xy⟩ simpa only [FineData.error, initialCounts, degree, coordinates, pinIndex, Equiv.prodCongr_apply, Equiv.refl_apply, Prod.map_apply, Int.cast_natCast, Nat.cast_pow] using CoarseCounts.pinnedCount_approx hs hL ha (pinIndex s L (k, xy)) end DistanceCounts.DegreeIndices end end BodyFile098 -- Source: DistanceCounts/PhysicalAssembly.lean section BodyFile099 /-! Realize the numeric corrections on the full original geometric configuration. -/ noncomputable section namespace DistanceCounts.PhysicalAssembly /-- Reindexing blocks leaves both grid coordinates, and hence every floor term, unchanged. -/ theorem score_pinIndex {s L : ℕ} (δ : ℝ) (Z : CoarseGrid.PinIndex (2 * s) L → ℤ) (i : Fin ((2 * s) ^ 2) × GridPairs.Grid L) (a : ℝ × ℝ) : SkewScores.score δ Z (DegreeIndices.pinIndex s L i) a = SkewScores.score δ (fun j => Z (DegreeIndices.pinIndex s L j)) i a := by rfl /-- All three extensions retain their entire predecessor. The final formula holds on every original pin, not only on the good-degree witness family. -/ theorem exists_realization {s L H B ell : ℕ} {δ E ε : ℝ} {p : Fin (2 * s) ⊕ Fin (2 * s) → ℕ} {z : Fin (2 * s) ⊕ Fin (2 * s) → GaussianInt} (hL : 0 < L) (hadm : CoarseConditions.Admissible s L p z ε) (hδ : 0 < δ) (hδ1 : δ < 1) {a : ℝ × ℝ} (ha : a ∈ SkewParameters.good δ L E) (hell : 0 < ell) (qrow : Fin ((2 * s) ^ 2) × Fin L → Fin H) (q2 : Fin ((2 * s) ^ 2) → Fin (L ^ 2) → ℤ) (hq2 : ∀ b w, 0 ≤ q2 b w ∧ q2 b w ≤ 2 * (B : ℤ)) : ∃ (Q : Finset Point) (C₀ C₁ C₂ : ℕ), CoarseGrid.pins L p z ⊆ Q ∧ Q.card = (CoarseGrid.pins L p z).card + C₀ + C₁ + C₂ ∧ C₀ ≤ 50 * (2 * s) * L ^ 2 ∧ C₁ ≤ 2 * (2 * s) ^ 2 * H * L ∧ C₂ ≤ (2 * B) * (ell * 2 ^ ell + (2 * s) ^ 2 * (L ^ 2 / ell + 1)) ∧ ∀ i : Fin ((2 * s) ^ 2) × GridPairs.Grid L, (pinnedCount Q (CoarseGrid.pin p z (DegreeIndices.pinIndex s L i)) : ℤ) = SkewScores.score δ (DegreeIndices.initialCounts p z) i a - ((qrow (i.1, i.2.2)).val : ℤ) - q2 i.1 (CoarseLabels.gridEquiv L i.2) + (C₀ : ℤ) + (C₁ : ℤ) + (C₂ : ℤ) + ⌊SkewScores.commonConst δ L a⌋ := by classical have hz : ∀ i, ¬(p i : GaussianInt) ∣ z i := fun i => GaussianNorm.not_dvd_of_isUnit_residue (p i) (hadm.prime i) (hadm.inert i) (z i) (hadm.units i) obtain ⟨Y, C₀, hPY, hYcard, hC₀, hYcount⟩ := SkewScores.exists_score_extension p z hadm.prime hadm.injective hz hadm.inert hL hδ hδ1 (CoarseGrid.pins L p z) (Finset.Subset.refl _) ha obtain ⟨R, C₁, hYR, hRcard, hC₁, hRcount⟩ := CoarseLabels.exists_rows_le_two (H := H) p z hadm.prime hadm.injective hadm.inert hadm.projection hL Y hPY (fun b y => (qrow (DegreeIndices.blockEquiv s b, y)).val) (fun b y => (qrow (DegreeIndices.blockEquiv s b, y)).isLt.le) obtain ⟨Q, C₂, hRQ, hQcard, hC₂, hQcount⟩ := CoarseLabels.exists_finite_int (H := 2 * B) p z hadm.prime hadm.injective hadm.inert hadm.projection hell R (hPY.trans hYR) (fun b w => q2 (DegreeIndices.blockEquiv s b) w) (fun b w => (hq2 _ _).1) (fun b w => by simpa only [Nat.cast_mul, Nat.cast_ofNat] using (hq2 (DegreeIndices.blockEquiv s b) w).2) refine ⟨Q, C₀, C₁, C₂, hPY.trans (hYR.trans hRQ), ?_, hC₀, hC₁, hC₂, ?_⟩ · rw [hQcard, hRcard, hYcard] · intro i have hc₀ := hYcount (DegreeIndices.pinIndex s L i) rw [score_pinIndex] at hc₀ change (pinnedCount Y (CoarseGrid.pin p z (DegreeIndices.pinIndex s L i)) : ℤ) = SkewScores.score δ (DegreeIndices.initialCounts p z) i a + (C₀ : ℤ) + ⌊SkewScores.commonConst δ L a⌋ at hc₀ have hc₁ : (pinnedCount R (CoarseGrid.pin p z (DegreeIndices.pinIndex s L i)) : ℤ) + ((qrow (i.1, i.2.2)).val : ℤ) = (pinnedCount Y (CoarseGrid.pin p z (DegreeIndices.pinIndex s L i)) : ℤ) + (C₁ : ℤ) := by have h := congrArg (fun n : ℕ => (n : ℤ)) (hRcount ((DegreeIndices.blockEquiv s).symm i.1) i.2.1 i.2.2) push_cast at h simpa only [DegreeIndices.pinIndex_apply, Equiv.apply_symm_apply, Prod.mk.eta] using h have hc₂ : (pinnedCount Q (CoarseGrid.pin p z (DegreeIndices.pinIndex s L i)) : ℤ) + q2 i.1 (CoarseLabels.gridEquiv L i.2) = (pinnedCount R (CoarseGrid.pin p z (DegreeIndices.pinIndex s L i)) : ℤ) + (C₂ : ℤ) := by have h := hQcount ((DegreeIndices.blockEquiv s).symm i.1) (CoarseLabels.gridEquiv L i.2) simpa only [CoarseLabels.indexedPin_gridEquiv, Equiv.apply_symm_apply, DegreeIndices.pinIndex_apply] using h omega /-- Injective actual adjusted scores give distinct counts in the actual spectrum. No point, distance, disjointness, or geometric-budget hypothesis is assumed. -/ theorem exists_configuration {s L H B ell : ℕ} {δ E ε : ℝ} {p : Fin (2 * s) ⊕ Fin (2 * s) → ℕ} {z : Fin (2 * s) ⊕ Fin (2 * s) → GaussianInt} (_hs : 0 < s) (hL : 0 < L) (hadm : CoarseConditions.Admissible s L p z ε) (hδ : 0 < δ) (hδ1 : δ < 1) {a : ℝ × ℝ} (ha : a ∈ SkewParameters.good δ L E) (_hH : 0 < H) (hell : 0 < ell) (qrow : Fin ((2 * s) ^ 2) × Fin L → Fin H) (q2 : Fin ((2 * s) ^ 2) → Fin (L ^ 2) → ℤ) (hq2 : ∀ b w, 0 ≤ q2 b w ∧ q2 b w ≤ 2 * (B : ℤ)) (S : Finset (Fin ((DegreeIndices.good s).card * L ^ 2))) (hS : Set.InjOn (fun i => SkewScores.score δ (DegreeIndices.initialCounts p z) (FineIndex.ambient (DegreeIndices.good s) i) a - ((qrow (FineIndex.group (DegreeIndices.good s) i)).val : ℤ) - q2 (FineIndex.ambient (DegreeIndices.good s) i).1 (CoarseLabels.gridEquiv L (FineIndex.ambient (DegreeIndices.good s) i).2)) S) : ∃ Q : Finset Point, CoarseGrid.pins L p z ⊆ Q ∧ S.card ≤ diversity Q ∧ Q.card ≤ (((2 * s) ^ 2 + 50 * (2 * s)) * L ^ 2) + 2 * (2 * s) ^ 2 * H * L + (2 * B) * (ell * 2 ^ ell + (2 * s) ^ 2 * (L ^ 2 / ell + 1)) := by classical obtain ⟨Q, C₀, C₁, C₂, hPQ, hcard, hC₀, hC₁, hC₂, hcount⟩ := exists_realization hL hadm hδ hδ1 ha hell qrow q2 hq2 let count : Fin ((DegreeIndices.good s).card * L ^ 2) → ℕ := fun i => pinnedCount Q (CoarseGrid.pin p z (DegreeIndices.pinIndex s L (FineIndex.ambient (DegreeIndices.good s) i))) have hcount_inj : Set.InjOn count S := by intro i hi j hj hij apply hS hi hj have hi' := hcount (FineIndex.ambient (DegreeIndices.good s) i) have hj' := hcount (FineIndex.ambient (DegreeIndices.good s) j) have he : (count i : ℤ) = (count j : ℤ) := congrArg (fun n : ℕ => (n : ℤ)) hij dsimp only [count] at he dsimp only [FineIndex.group] omega have hspectrum : S.image count ⊆ countSpectrum Q := by intro n hn obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp hn apply Finset.mem_image.mpr exact ⟨CoarseGrid.pin p z (DegreeIndices.pinIndex s L (FineIndex.ambient (DegreeIndices.good s) i)), hPQ (CoarseGrid.pin_mem p z _), rfl⟩ refine ⟨Q, hPQ, ?_, ?_⟩ · calc S.card = (S.image count).card := (Finset.card_image_iff.mpr hcount_inj).symm _ ≤ (countSpectrum Q).card := Finset.card_le_card hspectrum _ = diversity Q := rfl · rw [hcard, CoarseCounts.pins_card hadm] calc _ ≤ (2 * s) ^ 2 * L ^ 2 + 50 * (2 * s) * L ^ 2 + 2 * (2 * s) ^ 2 * H * L + (2 * B) * (ell * 2 ^ ell + (2 * s) ^ 2 * (L ^ 2 / ell + 1)) := by omega _ = _ := by ring end DistanceCounts.PhysicalAssembly end end BodyFile099 -- Source: DistanceCounts/Padding.lean section BodyFile100 /-! Fresh-point insertion and padding while preserving the original count distinctions. -/ noncomputable section namespace DistanceCounts /-- Inserting a point other than the pin inserts exactly its distance into the palette. -/ theorem distanceValues_insert {X : Finset Point} {p q : Point} (hqp : q ≠ p) : distanceValues (insert q X) p = insert (dist p q) (distanceValues X p) := by classical simp only [distanceValues, Finset.erase_insert_of_ne hqp, Finset.image_insert] /-- A genuinely new distance increases the positive pinned-distance count by one. -/ theorem pinnedCount_insert_of_new_distance {X : Finset Point} {p q : Point} (hqp : q ≠ p) (hnew : dist p q ∉ distanceValues X p) : pinnedCount (insert q X) p = pinnedCount X p + 1 := by classical unfold pinnedCount rw [distanceValues_insert hqp, Finset.card_insert_of_notMem hnew] /-- All old witnesses receive the same increment, so every count distinction survives. -/ theorem insert_preserves_witness_distinctness {X W : Finset Point} {q : Point} (hWX : W ⊆ X) (hq : q ∉ X) (hnew : ∀ p ∈ W, dist p q ∉ distanceValues X p) {p r : Point} (hp : p ∈ W) (hr : r ∈ W) : pinnedCount (insert q X) p = pinnedCount (insert q X) r ↔ pinnedCount X p = pinnedCount X r := by have hqp : q ≠ p := fun h => hq (h.symm ▸ hWX hp) have hqr : q ≠ r := fun h => hq (h.symm ▸ hWX hr) rw [pinnedCount_insert_of_new_distance hqp (hnew p hp), pinnedCount_insert_of_new_distance hqr (hnew r hr)] omega /-- A common shift of the old counts cannot reduce their spectrum cardinality. -/ theorem diversity_le_of_common_shift {X Y : Finset Point} (hXY : X ⊆ Y) (k : ℕ) (hcount : ∀ p ∈ X, pinnedCount Y p = pinnedCount X p + k) : diversity X ≤ diversity Y := by classical have hsub : (countSpectrum X).image (fun r => r + k) ⊆ countSpectrum Y := by intro r hr obtain ⟨s, hs, rfl⟩ := Finset.mem_image.mp hr obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hs exact Finset.mem_image.mpr ⟨p, hXY hp, hcount p hp⟩ have hinj : Function.Injective (fun r : ℕ => r + k) := by intro a b hab exact Nat.add_right_cancel hab calc diversity X = ((countSpectrum X).image (fun r => r + k)).card := (Finset.card_image_of_injective _ hinj).symm _ ≤ diversity Y := Finset.card_le_card hsub /-- An arbitrarily distant point can simultaneously lie beyond every old distance at every old pin. This proves finite-circle avoidance using the triangle inequality. -/ theorem exists_far_fresh_point (X : Finset Point) (R : ℝ) : ∃ q : Point, q ∉ X ∧ R < ‖q‖ ∧ ∀ p ∈ X, ∀ y ∈ X, dist p y < dist p q := by classical let S : ℝ := ∑ p ∈ X, ‖p‖ have hS : 0 ≤ S := Finset.sum_nonneg (fun p _ => norm_nonneg p) have hbound : ∀ p ∈ X, ‖p‖ ≤ S := by intro p hp exact Finset.single_le_sum (fun y _ => norm_nonneg y) hp obtain ⟨q, hq⟩ := NormedSpace.exists_lt_norm ℝ Point (3 * S + |R| + 1) refine ⟨q, ?_, ?_, ?_⟩ · intro hmem have := hbound q hmem have := abs_nonneg R linarith · have := le_abs_self R linarith · intro p hp y hy have hpbound := hbound p hp have hybound := hbound y hy have hupper := dist_le_norm_add_norm p y have hlower : ‖q‖ ≤ ‖p‖ + dist p q := by simpa only [dist_zero_left] using dist_triangle (0 : Point) p q have := abs_nonneg R linarith /-- No geometric avoidance hypothesis is required: the new point is constructed from unboundedness of Euclidean space and a finite norm bound. -/ theorem exists_fresh_point_with_new_distances (X : Finset Point) (R : ℝ) : ∃ q : Point, q ∉ X ∧ R < ‖q‖ ∧ ∀ p ∈ X, dist p q ∉ distanceValues X p := by classical obtain ⟨q, hq, hR, hfar⟩ := exists_far_fresh_point X R refine ⟨q, hq, hR, ?_⟩ intro p hp hmem obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp hmem have hlt := hfar p hp y (Finset.mem_erase.mp hy).2 exact (ne_of_lt hlt) heq /-- Extend by one point, incrementing every original count by exactly one. -/ theorem exists_one_point_extension (X : Finset Point) : ∃ Y : Finset Point, X ⊆ Y ∧ Y.card = X.card + 1 ∧ (∀ p ∈ X, pinnedCount Y p = pinnedCount X p + 1) ∧ diversity X ≤ diversity Y := by classical obtain ⟨q, hq, _, hnew⟩ := exists_fresh_point_with_new_distances X 0 have hcount : ∀ p ∈ X, pinnedCount (insert q X) p = pinnedCount X p + 1 := by intro p hp apply pinnedCount_insert_of_new_distance · intro heq exact hq (heq.symm ▸ hp) · exact hnew p hp refine ⟨insert q X, Finset.subset_insert _ _, Finset.card_insert_of_notMem hq, hcount, ?_⟩ exact diversity_le_of_common_shift (Finset.subset_insert _ _) 1 hcount /-- Repeated padding preserves the original witnesses and adds a common exact shift. -/ theorem exists_padding_add (X : Finset Point) (k : ℕ) : ∃ Y : Finset Point, X ⊆ Y ∧ Y.card = X.card + k ∧ (∀ p ∈ X, pinnedCount Y p = pinnedCount X p + k) ∧ diversity X ≤ diversity Y := by induction k with | zero => exact ⟨X, Finset.Subset.refl _, by omega, fun _ _ => by omega, le_refl _⟩ | succ k ih => obtain ⟨Y, hXY, hYcard, hYcount, hYdiv⟩ := ih obtain ⟨Z, hYZ, hZcard, hZcount, hZdiv⟩ := exists_one_point_extension Y refine ⟨Z, hXY.trans hYZ, by omega, ?_, hYdiv.trans hZdiv⟩ intro p hp rw [hZcount p (hXY hp), hYcount p hp] omega /-- Every larger cardinality is attainable without losing any count diversity. -/ theorem exists_padding_card (X : Finset Point) (n : ℕ) (hn : X.card ≤ n) : ∃ Y : Finset Point, X ⊆ Y ∧ Y.card = n ∧ (∀ p ∈ X, pinnedCount Y p = pinnedCount X p + (n - X.card)) ∧ diversity X ≤ diversity Y := by obtain ⟨Y, hXY, hcard, hcount, hdiv⟩ := exists_padding_add X (n - X.card) exact ⟨Y, hXY, by omega, hcount, hdiv⟩ end DistanceCounts end end BodyFile100 -- Source: DistanceCounts/TargetBridge.lean section BodyFile101 /-! The exact bridge to the published target; the epsilon construction remains a hypothesis. -/ noncomputable section open Filter open scoped Topology namespace DistanceCounts /-- The official helper includes self-distance; the mathematical argument does not. -/ theorem official_pinnedCount_eq (X : Finset Point) (p : Point) (hp : p ∈ X) : distinctDistancesFrom X p = pinnedCount X p + 1 := by classical have hz : (0 : ℝ) ∉ distanceValues X p := by intro h obtain ⟨q, hq, heq⟩ := Finset.mem_image.mp h exact (Finset.mem_erase.mp hq).1 (dist_eq_zero.mp heq).symm have himage : X.image (fun q => dist q p) = insert 0 (distanceValues X p) := by calc X.image (fun q => dist q p) = (insert p (X.erase p)).image (fun q => dist q p) := by rw [Finset.insert_erase hp] _ = insert 0 (distanceValues X p) := by simp only [Finset.image_insert, dist_self, distanceValues, dist_comm] unfold distinctDistancesFrom pinnedCount rw [himage, Finset.card_insert_of_notMem hz] /-- Adding one to every count leaves the diversity exactly unchanged. -/ theorem official_spectrum_card (X : Finset Point) : (X.image (distinctDistancesFrom X)).card = diversity X := by classical have himage : X.image (distinctDistancesFrom X) = (countSpectrum X).image (fun k : ℕ => k + 1) := by unfold countSpectrum rw [Finset.image_image] exact Finset.image_congr (fun p hp => official_pinnedCount_eq X p hp) rw [himage, Finset.card_image_of_injective _ (fun _ _ h => Nat.add_right_cancel h)] rfl /-- Every configuration bounds the official supremum from below. -/ theorem diversity_le_official_max (X : Finset Point) : diversity X ≤ EuclideanGeometry.maximalDistinctDistancesFrom X.card := by classical unfold EuclideanGeometry.maximalDistinctDistancesFrom apply le_csSup · refine ⟨X.card, ?_⟩ rintro k ⟨Y, hY, rfl⟩ exact Finset.card_image_le.trans_eq hY · exact ⟨X, rfl, official_spectrum_card X⟩ /-- The official extremal function has the elementary bound needed for the limit. -/ theorem official_max_le (n : ℕ) : EuclideanGeometry.maximalDistinctDistancesFrom n ≤ n := by classical unfold EuclideanGeometry.maximalDistinctDistancesFrom apply csSup_le' rintro k ⟨X, hX, rfl⟩ exact Finset.card_image_le.trans_eq hX /-- This is a proved implication, not a proof of its construction hypothesis. -/ theorem official_target_of_epsilon (h : Erdos653) : True ↔ ∃ o : ℕ → ℝ, o =o[atTop] (1 : ℕ → ℝ) ∧ ∀ᶠ n in atTop, (1 - o n) * n ≤ EuclideanGeometry.maximalDistinctDistancesFrom n := by constructor · intro _ let o : ℕ → ℝ := fun n => 1 - (EuclideanGeometry.maximalDistinctDistancesFrom n : ℝ) / n refine ⟨o, ?_, ?_⟩ · apply (Asymptotics.isLittleO_one_iff ℝ).mpr rw [Metric.tendsto_atTop] intro ε hε obtain ⟨N, hN⟩ := h (ε / 2) (by linarith) refine ⟨max N 1, ?_⟩ intro n hn have hnN : N ≤ n := (le_max_left N 1).trans hn have hn1 : 1 ≤ n := (le_max_right N 1).trans hn have hnpos : (0 : ℝ) < n := by exact_mod_cast hn1 obtain ⟨X, hX, hcount⟩ := hN n hnN have hmax : (diversity X : ℝ) ≤ EuclideanGeometry.maximalDistinctDistancesFrom n := by exact_mod_cast hX ▸ diversity_le_official_max X have hu : (EuclideanGeometry.maximalDistinctDistancesFrom n : ℝ) / n ≤ 1 := by apply (div_le_iff₀ hnpos).mpr simpa using (Nat.cast_le.mpr (official_max_le n) : (EuclideanGeometry.maximalDistinctDistancesFrom n : ℝ) ≤ n) have hl : 1 - ε / 2 ≤ (EuclideanGeometry.maximalDistinctDistancesFrom n : ℝ) / n := by exact (le_div_iff₀ hnpos).mpr (hcount.trans hmax) have hononneg : 0 ≤ o n := by dsimp [o]; linarith rw [Real.dist_eq, sub_zero, abs_of_nonneg hononneg] dsimp [o] linarith · filter_upwards [eventually_ge_atTop (1 : ℕ)] with n hn have hn0 : (n : ℝ) ≠ 0 := by exact_mod_cast (show n ≠ 0 by omega) dsimp [o] rw [sub_sub_cancel, div_mul_cancel₀ _ hn0] · intro _ trivial end DistanceCounts end end BodyFile101 -- Source: DistanceCounts/AsymptoticReduction.lean section BodyFile102 /-! Square-scale constructions imply the exact all-cardinalities target. The construction hypothesis in this file is explicit and is not asserted to have been proved. -/ noncomputable section open Filter open scoped Topology namespace DistanceCounts /-- Padding loses only a vanishing fraction between consecutive square scales. -/ theorem exact_sizes_of_square_family {A : ℕ} {b ε : ℝ} (hA : 0 < A) (hε : 0 < ε) (hc : 0 < b / (A : ℝ) - ε) (hfamily : ∃ L₀ : ℕ, ∀ L : ℕ, L₀ ≤ L → ∃ X : Finset Point, X.card ≤ A * L ^ 2 ∧ b * (L : ℝ) ^ 2 ≤ (diversity X : ℝ)) : ∃ N : ℕ, ∀ n : ℕ, N ≤ n → ∃ Y : Finset Point, Y.card = n ∧ (b / (A : ℝ) - ε) * n ≤ (diversity Y : ℝ) := by let c : ℝ := b / (A : ℝ) - ε obtain ⟨L₀, hfamily⟩ := hfamily obtain ⟨K₁, hK₁⟩ := exists_nat_gt (3 * c / ε) let K : ℕ := max L₀ (max 1 K₁) refine ⟨A * K ^ 2, ?_⟩ intro n hn let L : ℕ := Nat.sqrt (n / A) have hKsq : K ^ 2 ≤ n / A := by apply (Nat.le_div_iff_mul_le hA).mpr simpa only [Nat.mul_comm] using hn have hKL : K ≤ L := Nat.le_sqrt'.mpr hKsq have hL₀ : L₀ ≤ L := (le_max_left _ _).trans hKL have hL1 : 1 ≤ L := (le_max_left 1 K₁).trans ((le_max_right L₀ _).trans hKL) have hK₁L : K₁ ≤ L := (le_max_right 1 K₁).trans ((le_max_right L₀ _).trans hKL) have hsq : L ^ 2 ≤ n / A := Nat.le_sqrt'.mp (le_refl L) have hmod : n % A + A * (n / A) = n := Nat.mod_add_div n A have hfit : A * L ^ 2 ≤ n := (Nat.mul_le_mul_left A hsq).trans (by omega) have hnext : n / A + 1 ≤ (L + 1) ^ 2 := by exact Nat.succ_le_of_lt (Nat.lt_succ_sqrt' (n / A)) have hnupper : n < A * (L + 1) ^ 2 := by calc n = n % A + A * (n / A) := hmod.symm _ < A + A * (n / A) := Nat.add_lt_add_right (Nat.mod_lt n hA) _ _ = A * (n / A + 1) := by ring _ ≤ A * (L + 1) ^ 2 := Nat.mul_le_mul_left A hnext obtain ⟨X, hXcard, hXyield⟩ := hfamily L hL₀ obtain ⟨Y, hXY, hYcard, hshift, hdiv⟩ := exists_padding_card X n (hXcard.trans hfit) refine ⟨Y, hYcard, ?_⟩ have hAr : (0 : ℝ) < A := by exact_mod_cast hA have hLr : (1 : ℝ) ≤ L := by exact_mod_cast hL1 have hKr : (K₁ : ℝ) ≤ L := by exact_mod_cast hK₁L have hcpos : 0 < c := hc have hstep : 3 * c ≤ ε * (L : ℝ) := by have hm := (div_lt_iff₀ hε).mp hK₁ nlinarith have hquad : c * ((L : ℝ) + 1) ^ 2 ≤ (c + ε) * (L : ℝ) ^ 2 := by have hm := mul_le_mul_of_nonneg_right hstep (by positivity : (0 : ℝ) ≤ L) have he := mul_nonneg (le_of_lt hcpos) (sub_nonneg.mpr hLr) nlinarith have hb : (c + ε) * (A : ℝ) = b := by dsimp [c] rw [sub_add_cancel, div_mul_cancel₀ _ (ne_of_gt hAr)] have hnr : (n : ℝ) ≤ (A : ℝ) * ((L : ℝ) + 1) ^ 2 := by exact_mod_cast hnupper.le calc (b / (A : ℝ) - ε) * n = c * n := rfl _ ≤ c * ((A : ℝ) * ((L : ℝ) + 1) ^ 2) := mul_le_mul_of_nonneg_left hnr (le_of_lt hcpos) _ = (A : ℝ) * (c * ((L : ℝ) + 1) ^ 2) := by ring _ ≤ (A : ℝ) * ((c + ε) * (L : ℝ) ^ 2) := mul_le_mul_of_nonneg_left hquad (le_of_lt hAr) _ = b * (L : ℝ) ^ 2 := by rw [← hb]; ring _ ≤ (diversity X : ℝ) := hXyield _ ≤ (diversity Y : ℝ) := by exact_mod_cast hdiv /-- An integral upper coefficient absorbs the sublinear overhead of the manuscript. -/ def squareSize (s : ℕ) : ℕ := (2 * (s + 1)) ^ 2 + 50 * (2 * (s + 1)) + 1 /-- A fixed unit loss absorbs the lower-order error in the witness count. -/ def squareYield (s : ℕ) (δ : ℝ) : ℝ := (1 - δ) * ((2 * (s + 1) : ℕ) - (1 : ℝ)) ^ 2 - 1 /-- The substantive finite-configuration existence claim which still needs the arithmetic and probabilistic constructions. This is a proposition, not an axiom. -/ def SquareFamilies : Prop := ∀ s : ℕ, ∀ δ : ℝ, 0 < δ → δ < 1 / 2 → ∃ L₀ : ℕ, ∀ L : ℕ, L₀ ≤ L → ∃ X : Finset Point, X.card ≤ squareSize s * L ^ 2 ∧ squareYield s δ * (L : ℝ) ^ 2 ≤ (diversity X : ℝ) /-- The even-parameter density coefficients approach the claimed limit. -/ theorem square_ratio_tendsto (δ : ℝ) : Tendsto (fun s : ℕ => squareYield s δ / (squareSize s : ℝ)) atTop (𝓝 (1 - δ)) := by have ht : Tendsto (fun s : ℕ => (2 : ℝ) * ((s : ℝ) + 1)) atTop atTop := by apply tendsto_atTop_atTop.mpr intro b obtain ⟨N, hN⟩ := exists_nat_gt b refine ⟨N, ?_⟩ intro s hs have hNs : (N : ℝ) ≤ s := by exact_mod_cast hs nlinarith have hu : Tendsto (fun s : ℕ => ((2 : ℝ) * ((s : ℝ) + 1))⁻¹) atTop (𝓝 0) := tendsto_inv_atTop_zero.comp ht have hnum : Tendsto (fun s : ℕ => (1 - δ) * (1 - ((2 : ℝ) * ((s : ℝ) + 1))⁻¹) ^ 2 - (((2 : ℝ) * ((s : ℝ) + 1))⁻¹) ^ 2) atTop (𝓝 (1 - δ)) := by simpa using ((tendsto_const_nhds (x := 1 - δ)).mul (((tendsto_const_nhds (x := (1 : ℝ))).sub hu).pow 2)).sub (hu.pow 2) have hden : Tendsto (fun s : ℕ => (1 : ℝ) + 50 * ((2 : ℝ) * ((s : ℝ) + 1))⁻¹ + (((2 : ℝ) * ((s : ℝ) + 1))⁻¹) ^ 2) atTop (𝓝 1) := by simpa using ((tendsto_const_nhds (x := (1 : ℝ))).add ((tendsto_const_nhds (x := (50 : ℝ))).mul hu)).add (hu.pow 2) have hlim := hnum.div hden (by norm_num : (1 : ℝ) ≠ 0) simp only [div_one] at hlim apply hlim.congr' apply Eventually.of_forall intro s have ht0 : (2 : ℝ) * ((s : ℝ) + 1) ≠ 0 := by positivity dsimp [squareSize, squareYield] push_cast field_simp [ht0] /-- Fully proved all-n reduction, conditional on the still-unproved square families. -/ theorem epsilon_of_squareFamilies (h : SquareFamilies) : Erdos653 := by intro ε hε let δ : ℝ := min ε 1 / 4 have hδ : 0 < δ := by dsimp [δ]; positivity have hδ4 : δ ≤ 1 / 4 := by dsimp [δ] exact div_le_div_of_nonneg_right (min_le_right ε 1) (by norm_num) have hδhalf : δ < 1 / 2 := by linarith have hεδ : 3 * δ ≤ ε := by have hm := min_le_left ε (1 : ℝ) dsimp [δ] nlinarith [lt_min hε (by norm_num : (0 : ℝ) < 1)] have hratio : ∀ᶠ s : ℕ in atTop, 1 - 2 * δ < squareYield s δ / (squareSize s : ℝ) := (tendsto_order.mp (square_ratio_tendsto δ)).1 _ (by linarith) obtain ⟨s₀, hs₀⟩ := eventually_atTop.mp hratio have hs := hs₀ s₀ le_rfl have hc : 0 < squareYield s₀ δ / (squareSize s₀ : ℝ) - δ := by linarith have hA : 0 < squareSize s₀ := by unfold squareSize; omega obtain ⟨N, hN⟩ := exact_sizes_of_square_family hA hδ hc (h s₀ δ hδ hδhalf) refine ⟨N, ?_⟩ intro n hn obtain ⟨Y, hY, hyield⟩ := hN n hn refine ⟨Y, hY, ?_⟩ have hcoeff : 1 - ε ≤ squareYield s₀ δ / (squareSize s₀ : ℝ) - δ := by linarith exact (mul_le_mul_of_nonneg_right hcoeff (by positivity : (0 : ℝ) ≤ n)).trans hyield /-- No construction hypothesis is hidden: this implication alone is not Bounty.target. -/ theorem official_target_of_squareFamilies (h : SquareFamilies) : True ↔ ∃ o : ℕ → ℝ, o =o[atTop] (1 : ℕ → ℝ) ∧ ∀ᶠ n in atTop, (1 - o n) * n ≤ EuclideanGeometry.maximalDistinctDistancesFrom n := official_target_of_epsilon (epsilon_of_squareFamilies h) end DistanceCounts end end BodyFile102 -- Source: DistanceCounts/FinalConstruction.lean section BodyFile103 /-! Assembly of the full coarse grid, exact physical controls, and asymptotic budgets. -/ noncomputable section namespace DistanceCounts.FinalConstruction open Filter ConstructionScales open scoped Topology theorem eventually_correction_cost_le {K : ℕ} (hK : 0 < K) : ∀ᶠ L : ℕ in atTop, rowCost K L + unaryCost K L ≤ L ^ 2 := by have ht : Tendsto (fun L : ℕ => ((rowCost K L + unaryCost K L : ℕ) : ℝ) / (L : ℝ) ^ 2) atTop (𝓝 0) := by simpa only [Nat.cast_add, add_div, zero_add] using (tendsto_rowCost K).add (tendsto_unaryCost hK) filter_upwards [ht.eventually (gt_mem_nhds (by norm_num : (0 : ℝ) < 1)), eventually_gt_atTop 0] with L hcost hL have hm : (0 : ℝ) < (L : ℝ) ^ 2 := by positivity have hc : ((rowCost K L + unaryCost K L : ℕ) : ℝ) ≤ (L : ℝ) ^ 2 := by have h := (div_le_iff₀ hm).mp hcost.le simpa only [one_mul] using h exact_mod_cast hc /-- Every named arithmetic, probabilistic, and geometric premise is constructed above. -/ theorem squareFamilies : DistanceCounts.SquareFamilies := by intro s δ hδ hδhalf have hs : 0 < s + 1 := by omega have hδ1 : δ < 1 := by linarith let t := 2 * (s + 1) let K := t ^ 2 have hK : 0 < K := by dsimp [K, t]; positivity obtain ⟨p, z, ε, hε, hprimes, hbounded, hadmissible⟩ := OffsetSelection.exists_admissible_family hs let D := DegreeIndices.degree (s + 1) let good := DegreeIndices.good (s + 1) let Z0 : (L : ℕ) → Fin K × GridPairs.Grid L → ℤ := fun L => DegreeIndices.initialCounts (p L) (z L) let r : ℕ → ℝ := fun L => (K : ℝ) * ε L have hr : Tendsto r atTop (𝓝 0) := by simpa only [mul_zero] using hε.const_mul (K : ℝ) have herr : ∀ᶠ L in atTop, ∀ i, |FineData.error D (Z0 L) i| ≤ r L * (L : ℝ) ^ 2 := by filter_upwards [hadmissible, eventually_gt_atTop 0] with L hA hL intro i exact DegreeIndices.initialCounts_error hs hL hA i obtain ⟨loss, hloss0, hloss, hselection⟩ := FineSelection.exists_selection hK hδ hδ1 D good (DegreeIndices.degree_injective hs) (DegreeIndices.degree_bounds hs) Z0 hr herr have hlossSmall : ∀ᶠ L in atTop, loss L ≤ 1 := (hloss.eventually (gt_mem_nhds (by norm_num : (0 : ℝ) < 1))).mono fun _ h => h.le suffices hfinal : ∀ᶠ L : ℕ in atTop, ∃ Q : Finset Point, Q.card ≤ squareSize s * L ^ 2 ∧ squareYield s δ * (L : ℝ) ^ 2 ≤ (diversity Q : ℝ) from eventually_atTop.mp hfinal filter_upwards [hadmissible, hselection, eventually_correction_cost_le hK, hlossSmall, ConstructionScales.eventually_pos hK, eventually_gt_atTop 0] with L hA hselect hcost hsmall hpositive hL obtain ⟨a, ha, qrow, q2, S, hq2, hinj, hyield⟩ := hselect obtain ⟨Q, hPQ, hdiversity, hcard⟩ := PhysicalAssembly.exists_configuration hs hL hA hδ hδ1 ha hpositive.1 hpositive.2.2 qrow q2 hq2 S hinj refine ⟨Q, ?_, ?_⟩ · have hb : Q.card ≤ (K + 50 * t) * L ^ 2 + rowCost K L + unaryCost K L := hcard calc Q.card ≤ (K + 50 * t) * L ^ 2 + rowCost K L + unaryCost K L := hb _ = (K + 50 * t) * L ^ 2 + (rowCost K L + unaryCost K L) := by omega _ ≤ (K + 50 * t) * L ^ 2 + L ^ 2 := add_le_add (le_refl _) hcost _ = squareSize s * L ^ 2 := by unfold squareSize K t; ring · have hg : (good.card : ℝ) = (((2 * (s + 1) : ℕ) : ℝ) - 1) ^ 2 := by change ((DegreeIndices.good (s + 1)).card : ℝ) = _ rw [DegreeIndices.card_good hs, Nat.cast_pow, Nat.cast_sub (show 1 ≤ 2 * (s + 1) by omega), Nat.cast_one] have hdiv : (S.card : ℝ) ≤ (diversity Q : ℝ) := by exact_mod_cast hdiversity have hmul : loss L * (L : ℝ) ^ 2 ≤ (L : ℝ) ^ 2 := by simpa only [one_mul] using mul_le_mul_of_nonneg_right hsmall (sq_nonneg (L : ℝ)) calc squareYield s δ * (L : ℝ) ^ 2 = (1 - δ) * good.card * (L : ℝ) ^ 2 - (L : ℝ) ^ 2 := by unfold squareYield rw [hg] ring _ ≤ (1 - δ) * good.card * (L : ℝ) ^ 2 - loss L * (L : ℝ) ^ 2 := by linarith _ ≤ (S.card : ℝ) := hyield _ ≤ (diversity Q : ℝ) := hdiv end DistanceCounts.FinalConstruction end end BodyFile103 namespace Bounty -- Source: DistanceCounts/OfficialProof.lean section BodyFile104 theorem target : True ↔ ∃ o : ℕ → ℝ, Asymptotics.IsLittleO Filter.atTop o (1 : ℕ → ℝ) ∧ ∀ᶠ n in Filter.atTop, (1 - o n) * n ≤ EuclideanGeometry.maximalDistinctDistancesFrom n := DistanceCounts.official_target_of_squareFamilies DistanceCounts.FinalConstruction.squareFamilies end BodyFile104